GMRALAB0 ;HIRMFO/WAA-THIS PROGRAM WILL SELECT ALL LAB TEST FOR A PATIENT ;1/9/96 09:47
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ;THIS PROGRAM IS TO FIND AND PRINT ALL LAB TEST FOR A PATIENT
G:GMRAOUT EXIT
W @IOF N DIE,DA,GMRAXXX,GMRAX,GMRAGHC
S GMRALRCV=$S($T(GMTSLRCE^GMTSLRCE)']"":0,1:+$$VERSION^XPDUTL("GMTS"))
S GMRALRCG=$S(+GMRALRCV>2:"^TMP(",1:"^UTILITY(")
K @(GMRALRCG_"""LRC"",$J)"),^TMP($J,"GMRALAB")
S GMRADT=$P(^GMR(120.85,GMRAPA1,0),U)
D ^GMRADSP7 Q:'GMRAPA
SELECT W ! D LST
;SELECT ACTION
S GMRAOUT=0
K DIR S DIR(0)="SMOBA^A:ADD;D:DELETE;E:EDIT",DIR("A")="Select Action (A/D/E): "
S DIR("?",1)="ENTER A TO ADD NEW LAB DATA, D TO DELETE LAB DATA OR "
S DIR("?")="E TO EDIT LAB DATA ON FILE FOR THIS PATIENT"
D ^DIR K DIR I "^^"[Y S GMRAOUT=$L(Y) G EXIT
S GMRASEL=Y K DIR,GMRADFL
I GMRASEL="A" S GMRALOOK=0 W ! D ADD^GMRALAB1 K GMRALOOK G:GMRAOUT&('$D(GMRADFL)) EXIT G SELECT
I GMRASEL="D" W ! D DEL^GMRALAB1 G:GMRAOUT EXIT G SELECT
I GMRASEL="E" W ! D EDIT^GMRALAB1 G:GMRAOUT EXIT G SELECT
G SELECT
DISP ;DISPLAY ALL THE LABTEST FOR THIS PATIENT
K @(GMRALRCG_"""LRC"",$J)"),^TMP($J,"GMRALAB") S GMRACT=1,GMRACH=1
S DFN=+GMRAPA(0)
D DT Q:GMRAOUT
S GMRALOOK=1
I $D(GMRABGDT),+GMRALRCV S SEX=$P(GMRASEX,U),GMTS1=9999999-GMRAENDT,GMTS2=9999999-GMRABGDT,MAX=9999999,LRDFN=$P($G(^DPT(DFN,"LR")),U) D:LRDFN XTRCT^GMTSLRCE
K GMTS1,GMTS2,MAX,SEX,LRDFN
S GMRACT=0,GMRAX=0 F S GMRAX=$O(@(GMRALRCG_"""LRC"",$J,GMRAX)")) Q:GMRAX<1 D
.S GMRAY=0 F S GMRAY=$O(@(GMRALRCG_"""LRC"",$J,GMRAX,GMRAY)")) Q:GMRAY'>0 D
..S GMRACT=GMRACT+1,^TMP($J,"GMRALAB","L",GMRACT)=@(GMRALRCG_"""LRC"",$J,GMRAX,GMRAY)")
..Q
.Q
DISP2 S Z=0 W @IOF,!,"LAB TEST:",!,?3,"Collection DT",?19,"Test Name",?39,"Specimen",?52,"Results",?68,"Hi/Low",!!
I '$D(^TMP($J,"GMRALAB","L")) W ?5,$S('GMRALRCV:"THE LAB EXTRACT IS NOT PRESENT, COULD NOT GET LAB TEST DATA",1:"THERE IS NO LAB DATA FOR THIS PATIENT FOR THIS DATE RANGE.") K GMRABGDT,GMRAENDT Q
F GMRACH=GMRACH:1 Q:'$D(^TMP($J,"GMRALAB","L",GMRACH)) D Q:GMRAOUT
.I $Y+3>IOSL D Q:GMRAOUT
..S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 S:$D(DIROUT) GMRAOUT=2
..K Y,DIR,DIRUT,DIROUT,DUOUT,DTOUT
..I GMRAOUT Q
..W @IOF,!,"LAB TEST:",!,?3,"Collection DT",?19,"Test Name",?39,"Specimen",?52,"Results",?68,"Hi/Low",!!
..Q
.W $J(GMRACH,Z),?4,$P(^TMP($J,"GMRALAB","L",GMRACH),U)
.W ?20,$E($P(^TMP($J,"GMRALAB","L",GMRACH),U,3),1,18)
.W ?39,$E($P(^TMP($J,"GMRALAB","L",GMRACH),U,2),1,10)
.I $P(^TMP($J,"GMRALAB","L",GMRACH),U,5)'="" W ?50,$P(^TMP($J,"GMRALAB","L",GMRACH),U,5)
.W ?53,$E($P($P(^TMP($J,"GMRALAB","L",GMRACH),U,4),"|"),1,10)," ",$P(^TMP($J,"GMRALAB","L",GMRACH),U,6)
.W ?68 I $P(^TMP($J,"GMRALAB","L",GMRACH),U,8)'="" W $P(^TMP($J,"GMRALAB","L",GMRACH),U,8),"/",$P(^TMP($J,"GMRALAB","L",GMRACH),U,7)
.W !
.Q
K X,GMRACH,GMRACT,GMRAX,GMRAY,GMRAZ,X,Y
Q
LST ;This entry point is to display patient lab test adverse reaction.
I '$O(^GMR(120.85,GMRAPA1,4,0)) W !,"THIS PATIENT HAS NO LAB TEST ON FILE FOR THIS ADVERSE REACTION REPORT" K GMRABGDT,GMRAENDT Q
W @IOF,!,"This patient has the following Test selected: "
W !,"TEST/TX",?33,"RESULTS",?64,"DRAW DATE/TIME"
S GMRAXX=1,GMRAX=0 F S GMRAX=$O(^GMR(120.85,GMRAPA1,4,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
.I $Y+3>IOSL D Q:GMRAOUT
..S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 S:$D(DIROUT) GMRAOUT=2
..K Y,DIR,DIRUT,DIROUT,DUOUT,DTOUT
..I GMRAOUT Q
..W @IOF,!,"TEST/TX",?33,"RESULTS",?64,"DRAW DATE/TIME"
..Q
.W !,GMRAXX_") ",?5,$E($P(^GMR(120.85,GMRAPA1,4,GMRAX,0),U),1,26)
.W ?33,$E($P(^GMR(120.85,GMRAPA1,4,GMRAX,0),U,2),1,30)
.W ?64 W:$P(^GMR(120.85,GMRAPA1,4,GMRAX,0),U,3)>1 $$LDATE^GMRALAB1($P(^GMR(120.85,GMRAPA1,4,GMRAX,0),U,3))
.S GMRAXX=GMRAXX+1
.Q
K GMRAXX,GMRAX
Q
DT ;SELECT LOOKUP DATE RANGE
I GMRALOOK Q
I '$D(GMRABGDT) S (GMRABGDT,GMRAENDT)=""
W ! K GMRADFL
S X1=$S(GMRABGDT'="":+GMRABGDT,1:GMRADT),X2=0 D C^%DTC S Y=X D D^DIQ S %DT("A")="View Tx/Test from: ",%DT("B")=Y,%DT="AETP" D ^%DT K %DT I X="^" S GMRAOUT=2,GMRADFL=1 G DTEX
S GMRABGDT=+Y D D^DIQ S $P(GMRABGDT,U,2)=Y
S X1=$S(GMRAENDT'="":+GMRAENDT,1:GMRADT),X2=0 D C^%DTC S Y=X D D^DIQ S %DT("A")="To: ",%DT("B")=Y,%DT="AETP",%DT(0)=+GMRABGDT D ^%DT K %DT I X="^" S GMRAOUT=2,GMRADFL=1 G DTEX
S GMRAENDT=+Y S:'$P(GMRAENDT,".",2) GMRAENDT=GMRAENDT+.24 D D^DIQ S $P(GMRAENDT,U,2)=Y
DTEX K X2,X1,Y,X,%DT
Q
EXIT ;EXIT THE PROGRAM
K GMRADT,GMRABGDT,GMRAENDT,GMRASEL,DIR,X,Y,^TMP($J,"GMRALAB"),@(GMRALRCG_"""LRC"",$J)"),GMRALOOK,GMRADFL
Q
GMRALAB0 ;HIRMFO/WAA-THIS PROGRAM WILL SELECT ALL LAB TEST FOR A PATIENT ;1/9/96 09:47
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ;THIS PROGRAM IS TO FIND AND PRINT ALL LAB TEST FOR A PATIENT
+1 IF GMRAOUT
GOTO EXIT
+2 WRITE @IOF
NEW DIE,DA,GMRAXXX,GMRAX,GMRAGHC
+3 SET GMRALRCV=$SELECT($TEXT(GMTSLRCE^GMTSLRCE)']"":0,1:+$$VERSION^XPDUTL("GMTS"))
+4 SET GMRALRCG=$SELECT(+GMRALRCV>2:"^TMP(",1:"^UTILITY(")
+5 KILL @(GMRALRCG_"""LRC"",$J)"),^TMP($JOB,"GMRALAB")
+6 SET GMRADT=$PIECE(^GMR(120.85,GMRAPA1,0),U)
+7 DO ^GMRADSP7
IF 'GMRAPA
QUIT
SELECT WRITE !
DO LST
+1 ;SELECT ACTION
+2 SET GMRAOUT=0
+3 KILL DIR
SET DIR(0)="SMOBA^A:ADD;D:DELETE;E:EDIT"
SET DIR("A")="Select Action (A/D/E): "
+4 SET DIR("?",1)="ENTER A TO ADD NEW LAB DATA, D TO DELETE LAB DATA OR "
+5 SET DIR("?")="E TO EDIT LAB DATA ON FILE FOR THIS PATIENT"
+6 DO ^DIR
KILL DIR
IF "^^"[Y
SET GMRAOUT=$LENGTH(Y)
GOTO EXIT
+7 SET GMRASEL=Y
KILL DIR,GMRADFL
+8 IF GMRASEL="A"
SET GMRALOOK=0
WRITE !
DO ADD^GMRALAB1
KILL GMRALOOK
IF GMRAOUT&('$DATA(GMRADFL))
GOTO EXIT
GOTO SELECT
+9 IF GMRASEL="D"
WRITE !
DO DEL^GMRALAB1
IF GMRAOUT
GOTO EXIT
GOTO SELECT
+10 IF GMRASEL="E"
WRITE !
DO EDIT^GMRALAB1
IF GMRAOUT
GOTO EXIT
GOTO SELECT
+11 GOTO SELECT
DISP ;DISPLAY ALL THE LABTEST FOR THIS PATIENT
+1 KILL @(GMRALRCG_"""LRC"",$J)"),^TMP($JOB,"GMRALAB")
SET GMRACT=1
SET GMRACH=1
+2 SET DFN=+GMRAPA(0)
+3 DO DT
IF GMRAOUT
QUIT
+4 SET GMRALOOK=1
+5 IF $DATA(GMRABGDT)
IF +GMRALRCV
SET SEX=$PIECE(GMRASEX,U)
SET GMTS1=9999999-GMRAENDT
SET GMTS2=9999999-GMRABGDT
SET MAX=9999999
SET LRDFN=$PIECE($GET(^DPT(DFN,"LR")),U)
IF LRDFN
DO XTRCT^GMTSLRCE
+6 KILL GMTS1,GMTS2,MAX,SEX,LRDFN
+7 SET GMRACT=0
SET GMRAX=0
FOR
SET GMRAX=$ORDER(@(GMRALRCG_"""LRC"",$J,GMRAX)"))
IF GMRAX<1
QUIT
Begin DoDot:1
+8 SET GMRAY=0
FOR
SET GMRAY=$ORDER(@(GMRALRCG_"""LRC"",$J,GMRAX,GMRAY)"))
IF GMRAY'>0
QUIT
Begin DoDot:2
+9 SET GMRACT=GMRACT+1
SET ^TMP($JOB,"GMRALAB","L",GMRACT)=@(GMRALRCG_"""LRC"",$J,GMRAX,GMRAY)")
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
DISP2 SET Z=0
WRITE @IOF,!,"LAB TEST:",!,?3,"Collection DT",?19,"Test Name",?39,"Specimen",?52,"Results",?68,"Hi/Low",!!
+1 IF '$DATA(^TMP($JOB,"GMRALAB","L"))
WRITE ?5,$SELECT('GMRALRCV:"THE LAB EXTRACT IS NOT PRESENT, COULD NOT GET LAB TEST DATA",1:"THERE IS NO LAB DATA FOR THIS PATIENT FOR THIS DATE RANGE.")
KILL GMRABGDT,GMRAENDT
QUIT
+2 FOR GMRACH=GMRACH:1
IF '$DATA(^TMP($JOB,"GMRALAB","L",GMRACH))
QUIT
Begin DoDot:1
+3 IF $Y+3>IOSL
Begin DoDot:2
+4 SET DIR(0)="E"
DO ^DIR
IF 'Y
SET GMRAOUT=1
IF $DATA(DIROUT)
SET GMRAOUT=2
+5 KILL Y,DIR,DIRUT,DIROUT,DUOUT,DTOUT
+6 IF GMRAOUT
QUIT
+7 WRITE @IOF,!,"LAB TEST:",!,?3,"Collection DT",?19,"Test Name",?39,"Specimen",?52,"Results",?68,"Hi/Low",!!
+8 QUIT
End DoDot:2
IF GMRAOUT
QUIT
+9 WRITE $JUSTIFY(GMRACH,Z),?4,$PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U)
+10 WRITE ?20,$EXTRACT($PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,3),1,18)
+11 WRITE ?39,$EXTRACT($PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,2),1,10)
+12 IF $PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,5)'=""
WRITE ?50,$PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,5)
+13 WRITE ?53,$EXTRACT($PIECE($PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,4),"|"),1,10)," ",$PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,6)
+14 WRITE ?68
IF $PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,8)'=""
WRITE $PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,8),"/",$PIECE(^TMP($JOB,"GMRALAB","L",GMRACH),U,7)
+15 WRITE !
+16 QUIT
End DoDot:1
IF GMRAOUT
QUIT
+17 KILL X,GMRACH,GMRACT,GMRAX,GMRAY,GMRAZ,X,Y
+18 QUIT
LST ;This entry point is to display patient lab test adverse reaction.
+1 IF '$ORDER(^GMR(120.85,GMRAPA1,4,0))
WRITE !,"THIS PATIENT HAS NO LAB TEST ON FILE FOR THIS ADVERSE REACTION REPORT"
KILL GMRABGDT,GMRAENDT
QUIT
+2 WRITE @IOF,!,"This patient has the following Test selected: "
+3 WRITE !,"TEST/TX",?33,"RESULTS",?64,"DRAW DATE/TIME"
+4 SET GMRAXX=1
SET GMRAX=0
FOR
SET GMRAX=$ORDER(^GMR(120.85,GMRAPA1,4,GMRAX))
IF GMRAX<1
QUIT
Begin DoDot:1
+5 IF $Y+3>IOSL
Begin DoDot:2
+6 SET DIR(0)="E"
DO ^DIR
IF 'Y
SET GMRAOUT=1
IF $DATA(DIROUT)
SET GMRAOUT=2
+7 KILL Y,DIR,DIRUT,DIROUT,DUOUT,DTOUT
+8 IF GMRAOUT
QUIT
+9 WRITE @IOF,!,"TEST/TX",?33,"RESULTS",?64,"DRAW DATE/TIME"
+10 QUIT
End DoDot:2
IF GMRAOUT
QUIT
+11 WRITE !,GMRAXX_") ",?5,$EXTRACT($PIECE(^GMR(120.85,GMRAPA1,4,GMRAX,0),U),1,26)
+12 WRITE ?33,$EXTRACT($PIECE(^GMR(120.85,GMRAPA1,4,GMRAX,0),U,2),1,30)
+13 WRITE ?64
IF $PIECE(^GMR(120.85,GMRAPA1,4,GMRAX,0),U,3)>1
WRITE $$LDATE^GMRALAB1($PIECE(^GMR(120.85,GMRAPA1,4,GMRAX,0),U,3))
+14 SET GMRAXX=GMRAXX+1
+15 QUIT
End DoDot:1
IF GMRAOUT
QUIT
+16 KILL GMRAXX,GMRAX
+17 QUIT
DT ;SELECT LOOKUP DATE RANGE
+1 IF GMRALOOK
QUIT
+2 IF '$DATA(GMRABGDT)
SET (GMRABGDT,GMRAENDT)=""
+3 WRITE !
KILL GMRADFL
+4 SET X1=$SELECT(GMRABGDT'="":+GMRABGDT,1:GMRADT)
SET X2=0
DO C^%DTC
SET Y=X
DO D^DIQ
SET %DT("A")="View Tx/Test from: "
SET %DT("B")=Y
SET %DT="AETP"
DO ^%DT
KILL %DT
IF X="^"
SET GMRAOUT=2
SET GMRADFL=1
GOTO DTEX
+5 SET GMRABGDT=+Y
DO D^DIQ
SET $PIECE(GMRABGDT,U,2)=Y
+6 SET X1=$SELECT(GMRAENDT'="":+GMRAENDT,1:GMRADT)
SET X2=0
DO C^%DTC
SET Y=X
DO D^DIQ
SET %DT("A")="To: "
SET %DT("B")=Y
SET %DT="AETP"
SET %DT(0)=+GMRABGDT
DO ^%DT
KILL %DT
IF X="^"
SET GMRAOUT=2
SET GMRADFL=1
GOTO DTEX
+7 SET GMRAENDT=+Y
IF '$PIECE(GMRAENDT,".",2)
SET GMRAENDT=GMRAENDT+.24
DO D^DIQ
SET $PIECE(GMRAENDT,U,2)=Y
DTEX KILL X2,X1,Y,X,%DT
+1 QUIT
EXIT ;EXIT THE PROGRAM
+1 KILL GMRADT,GMRABGDT,GMRAENDT,GMRASEL,DIR,X,Y,^TMP($JOB,"GMRALAB"),@(GMRALRCG_"""LRC"",$J)"),GMRALOOK,GMRADFL
+2 QUIT
