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 Oct 16, 2024@17:41:24 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
