- GMRASIG1 ;HIRMFO/WAA-A/AR PATIENT SIGN OFF PART2 ;9/22/06 10:49
- ;;4.0;Adverse Reaction Tracking;**2,17,21,36**;Mar 29, 1996;Build 9
- PRINT ;Print out data to be signed off on
- N DIR,X,Y
- S GMRAPA=""
- I GMRASIGN W @IOF
- W !,"ADVERSE REACTION",!,"----------------" ;21
- S (GMRAI,GMRACNT)=0
- F S GMRACNT=$O(^TMP($J,"GMRASF",GMRACNT)) Q:GMRACNT<1 S GMRAPA=$O(^TMP($J,"GMRASF",GMRACNT,0)) Q:GMRAPA<0 D Q:GMRAOUT I $Y>(IOSL-4) D PAGE Q:GMRAOUT
- .W ! W:GMRACNTT>1 GMRACNT,")" ;21
- .S GMRAG=^GMR(120.8,GMRAPA,0),GMRADRG=$S($P(GMRAG,U,20)="D":1,1:0)
- .W " ",$P(GMRAG,U,2),! ;21
- .W !,?11,"Obs/Hist:",?21,$S($P(GMRAG,U,6)="o":"OBSERVED",$P(GMRAG,U,6)="h":"HISTORICAL",1:"") I $P(GMRAG,U,6)="o" W !,?12,"Obs d/t: ",$$FMTE^XLFDT($P(^GMR(120.85,$O(^GMR(120.85,"C",GMRAPA,0)),0),U)) ;21
- .K GMRAHEAD
- .K GMRAREC I $D(^GMR(120.8,GMRAPA,10,0)) D
- ..S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
- ..S GMRAREC=0 F S GMRAREC=$O(^GMR(120.8,GMRAPA,10,GMRAREC)) Q:GMRAREC'>0 D ;21
- ...S X=$G(^GMR(120.8,GMRAPA,10,GMRAREC,0)),GMRAREC(GMRAREC)=$S($P(X,U)'=GMRAOTH:$P($G(^GMRD(120.83,+$P(X,U),0)),U),1:$P(X,U,2)) ;21
- ...I $P(X,U,4)>0 S $P(GMRAREC(GMRAREC),U,2)=$$FMTE^XLFDT($P(X,U,4),2) ;21
- ...Q ;21
- ..Q
- .I $D(GMRAREC)=11 S GMRAREC=$O(GMRAREC("")) W !,?5,"Signs/Symptoms: ",?21,$P(GMRAREC(GMRAREC),U) W:$P(GMRAREC(GMRAREC),U,2)'="" " ("_$P(GMRAREC(GMRAREC),U,2)_")" ;21
- .;W ?65,$S($P(GMRAG,U,6)="o":"OBSERVED",$P(GMRAG,U,6)="h":"HISTORICAL",1:"")
- .I $G(GMRAREC)>0 F S GMRAREC=$O(GMRAREC(GMRAREC)) Q:GMRAREC<1 W !,?21,$P(GMRAREC(GMRAREC),U) W:$P(GMRAREC(GMRAREC),U,2)'="" " ("_$P(GMRAREC(GMRAREC),U,2)_")" I $Y>(IOSL-4) D PAGE Q:GMRAOUT ;21
- .Q:GMRAOUT D:$Y>(IOSL-4) PAGE Q:GMRAOUT W !
- .D OUTPUT^GMRAPEM1 Q:GMRAOUT
- .Q
- Q:GMRACNTT'>1
- Q:'GMRASIGN
- W (GMRACNTT+1),") All of the above",! ;17
- W (GMRACNTT+2),") None of the above",! ;17
- Q
- PAGE ;PAGE
- N DIR
- D ENDPG^GMRADSP3 Q:GMRAOUT
- W @IOF,!
- Q
- PNOTE ; Generate a Progress Note for a patient
- Q:$G(GMRAUSER,0)
- N GMRAOUT S GMRAOUT=0
- I $D(GMRASLL) D
- .N GMRAFLL,X
- .S X=0 F S X=$O(GMRASLL(X)) Q:X<1 D
- ..I GMRASLL(X) Q
- ..I $P($G(^GMR(120.8,X,0)),U,6)'="o" Q
- ..S GMRAFLL(X)=""
- ..Q
- .Q:'$D(GMRAFLL)
- .D EN1^GMRAPET0(DFN,.GMRAFLL,"S",.GMRAOUT)
- .Q
- Q
- ENCNT ; Count how many entries where selected and set up Sort order
- N SUB ;36
- S (GMRACNTT,X)=0 K ^TMP($J,"GMRARE") ; Resort the entries
- F S X=$O(^TMP($J,"GMRASF","B",X)) Q:X<1 D
- .S GMRACNTT=GMRACNTT+1
- .S SUB=$O(^TMP($J,"GMRASF","B",X,0)) ;36
- .S ^TMP($J,"GMRARE",GMRACNTT,X)=+$G(^TMP($J,"GMRASF","B",X,SUB)) ;36
- .S ^TMP($J,"GMRARE","B",X,GMRACNTT)=+$G(^TMP($J,"GMRASF","B",X,SUB)) ;36
- .Q
- K ^TMP($J,"GMRASF")
- M ^TMP($J,"GMRASF")=^TMP($J,"GMRARE")
- K ^TMP($J,"GMRARE")
- Q
- YNSO ;Select sign off for a patient
- W @IOF,!,"Causative Agent Data edited this Session:"
- K X D PRINT ; Redisplay the reactions
- K DIR S DIR(0)="L^1:"_(GMRACNTT+2),GMRALL=GMRACNTT+1,GMRANON=GMRACNTT+2 ;17
- S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
- S DIR("A")="Select the Correct data "
- S DIR("?")="^D PRINT^GMRASIG1"
- D ^DIR K DIR
- I $D(DTOUT)!($D(DUOUT)) S Y=GMRANON_","
- I Y=(GMRALL_",") D ALLSNG^GMRASIGN ; User select all the reaction
- I Y=(GMRANON_",") S Y="" ; user select not of the reactions
- I $F(Y,","_GMRALL_",") W !,"INVALID SELECTION: You can only select ",GMRACNT+1,") All by itself." G YNSO
- I $F(Y,","_GMRANON_",") W !,"INVALID SELECTION: You can only select ",GMRACNT+2,") None by itself." G YNSO
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRASIG1 3523 printed Jan 18, 2025@02:41:47 Page 2
- GMRASIG1 ;HIRMFO/WAA-A/AR PATIENT SIGN OFF PART2 ;9/22/06 10:49
- +1 ;;4.0;Adverse Reaction Tracking;**2,17,21,36**;Mar 29, 1996;Build 9
- PRINT ;Print out data to be signed off on
- +1 NEW DIR,X,Y
- +2 SET GMRAPA=""
- +3 IF GMRASIGN
- WRITE @IOF
- +4 ;21
- WRITE !,"ADVERSE REACTION",!,"----------------"
- +5 SET (GMRAI,GMRACNT)=0
- +6 FOR
- SET GMRACNT=$ORDER(^TMP($JOB,"GMRASF",GMRACNT))
- if GMRACNT<1
- QUIT
- SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF",GMRACNT,0))
- if GMRAPA<0
- QUIT
- Begin DoDot:1
- +7 ;21
- WRITE !
- if GMRACNTT>1
- WRITE GMRACNT,")"
- +8 SET GMRAG=^GMR(120.8,GMRAPA,0)
- SET GMRADRG=$SELECT($PIECE(GMRAG,U,20)="D":1,1:0)
- +9 ;21
- WRITE " ",$PIECE(GMRAG,U,2),!
- +10 ;21
- WRITE !,?11,"Obs/Hist:",?21,$SELECT($PIECE(GMRAG,U,6)="o":"OBSERVED",$PIECE(GMRAG,U,6)="h":"HISTORICAL",1:"")
- IF $PIECE(GMRAG,U,6)="o"
- WRITE !,?12,"Obs d/t: ",$$FMTE^XLFDT($PIECE(^GMR(120.85,$ORDER(^GMR(120.85,"C",GMRAPA,0)),0),U))
- +11 KILL GMRAHEAD
- +12 KILL GMRAREC
- IF $DATA(^GMR(120.8,GMRAPA,10,0))
- Begin DoDot:2
- +13 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
- +14 ;21
- SET GMRAREC=0
- FOR
- SET GMRAREC=$ORDER(^GMR(120.8,GMRAPA,10,GMRAREC))
- if GMRAREC'>0
- QUIT
- Begin DoDot:3
- +15 ;21
- SET X=$GET(^GMR(120.8,GMRAPA,10,GMRAREC,0))
- SET GMRAREC(GMRAREC)=$SELECT($PIECE(X,U)'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+$PIECE(X,U),0)),U),1:$PIECE(X,U,2))
- +16 ;21
- IF $PIECE(X,U,4)>0
- SET $PIECE(GMRAREC(GMRAREC),U,2)=$$FMTE^XLFDT($PIECE(X,U,4),2)
- +17 ;21
- QUIT
- End DoDot:3
- +18 QUIT
- End DoDot:2
- +19 ;21
- IF $DATA(GMRAREC)=11
- SET GMRAREC=$ORDER(GMRAREC(""))
- WRITE !,?5,"Signs/Symptoms: ",?21,$PIECE(GMRAREC(GMRAREC),U)
- if $PIECE(GMRAREC(GMRAREC),U,2)'=""
- WRITE " ("_$PIECE(GMRAREC(GMRAREC),U,2)_")"
- +20 ;W ?65,$S($P(GMRAG,U,6)="o":"OBSERVED",$P(GMRAG,U,6)="h":"HISTORICAL",1:"")
- +21 ;21
- IF $GET(GMRAREC)>0
- FOR
- SET GMRAREC=$ORDER(GMRAREC(GMRAREC))
- if GMRAREC<1
- QUIT
- WRITE !,?21,$PIECE(GMRAREC(GMRAREC),U)
- if $PIECE(GMRAREC(GMRAREC),U,2)'=""
- WRITE " ("_$PIECE(GMRAREC(GMRAREC),U,2)_")"
- IF $Y>(IOSL-4)
- DO PAGE
- if GMRAOUT
- QUIT
- +22 if GMRAOUT
- QUIT
- if $Y>(IOSL-4)
- DO PAGE
- if GMRAOUT
- QUIT
- WRITE !
- +23 DO OUTPUT^GMRAPEM1
- if GMRAOUT
- QUIT
- +24 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- IF $Y>(IOSL-4)
- DO PAGE
- if GMRAOUT
- QUIT
- +25 if GMRACNTT'>1
- QUIT
- +26 if 'GMRASIGN
- QUIT
- +27 ;17
- WRITE (GMRACNTT+1),") All of the above",!
- +28 ;17
- WRITE (GMRACNTT+2),") None of the above",!
- +29 QUIT
- PAGE ;PAGE
- +1 NEW DIR
- +2 DO ENDPG^GMRADSP3
- if GMRAOUT
- QUIT
- +3 WRITE @IOF,!
- +4 QUIT
- PNOTE ; Generate a Progress Note for a patient
- +1 if $GET(GMRAUSER,0)
- QUIT
- +2 NEW GMRAOUT
- SET GMRAOUT=0
- +3 IF $DATA(GMRASLL)
- Begin DoDot:1
- +4 NEW GMRAFLL,X
- +5 SET X=0
- FOR
- SET X=$ORDER(GMRASLL(X))
- if X<1
- QUIT
- Begin DoDot:2
- +6 IF GMRASLL(X)
- QUIT
- +7 IF $PIECE($GET(^GMR(120.8,X,0)),U,6)'="o"
- QUIT
- +8 SET GMRAFLL(X)=""
- +9 QUIT
- End DoDot:2
- +10 if '$DATA(GMRAFLL)
- QUIT
- +11 DO EN1^GMRAPET0(DFN,.GMRAFLL,"S",.GMRAOUT)
- +12 QUIT
- End DoDot:1
- +13 QUIT
- ENCNT ; Count how many entries where selected and set up Sort order
- +1 ;36
- NEW SUB
- +2 ; Resort the entries
- SET (GMRACNTT,X)=0
- KILL ^TMP($JOB,"GMRARE")
- +3 FOR
- SET X=$ORDER(^TMP($JOB,"GMRASF","B",X))
- if X<1
- QUIT
- Begin DoDot:1
- +4 SET GMRACNTT=GMRACNTT+1
- +5 ;36
- SET SUB=$ORDER(^TMP($JOB,"GMRASF","B",X,0))
- +6 ;36
- SET ^TMP($JOB,"GMRARE",GMRACNTT,X)=+$GET(^TMP($JOB,"GMRASF","B",X,SUB))
- +7 ;36
- SET ^TMP($JOB,"GMRARE","B",X,GMRACNTT)=+$GET(^TMP($JOB,"GMRASF","B",X,SUB))
- +8 QUIT
- End DoDot:1
- +9 KILL ^TMP($JOB,"GMRASF")
- +10 MERGE ^TMP($JOB,"GMRASF")=^TMP($JOB,"GMRARE")
- +11 KILL ^TMP($JOB,"GMRARE")
- +12 QUIT
- YNSO ;Select sign off for a patient
- +1 WRITE @IOF,!,"Causative Agent Data edited this Session:"
- +2 ; Redisplay the reactions
- KILL X
- DO PRINT
- +3 ;17
- KILL DIR
- SET DIR(0)="L^1:"_(GMRACNTT+2)
- SET GMRALL=GMRACNTT+1
- SET GMRANON=GMRACNTT+2
- +4 SET DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
- +5 SET DIR("A")="Select the Correct data "
- +6 SET DIR("?")="^D PRINT^GMRASIG1"
- +7 DO ^DIR
- KILL DIR
- +8 IF $DATA(DTOUT)!($DATA(DUOUT))
- SET Y=GMRANON_","
- +9 ; User select all the reaction
- IF Y=(GMRALL_",")
- DO ALLSNG^GMRASIGN
- +10 ; user select not of the reactions
- IF Y=(GMRANON_",")
- SET Y=""
- +11 IF $FIND(Y,","_GMRALL_",")
- WRITE !,"INVALID SELECTION: You can only select ",GMRACNT+1,") All by itself."
- GOTO YNSO
- +12 IF $FIND(Y,","_GMRANON_",")
- WRITE !,"INVALID SELECTION: You can only select ",GMRACNT+2,") None by itself."
- GOTO YNSO
- +13 QUIT