GMRAPT ;HIRMFO/WAA-P&T COMMITTEE COMPLETION SYSTEM ;12/1/95 14:45
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; Entry for ENTER/EDIT P&T COMMITTEE DATA option
D MAIN
D EXIT
Q
MAIN ;MAIN STARTING POINT
S GMRAOUT=0,GMRALAGO=1 D EN1^GMRAU85 G:GMRAPA1<1 EXIT1
S GMRAPA=0 D ^GMRADSP7
;v=New line
I $P(GMRAPA(0),U,20)'["D" W !,"YOU CAN ONLY EDIT OBSERVED DRUG REACTIONS",! Q
;V=Old line
;I $P(GMRAPA(0),U,20)'["D"!($P(GMRAPA(0),U,6)'="o") W !,"YOU CAN ONLY EDIT OBSERVED DRUG REACTIONS",! Q
REP1 W @IOF,!,"P&T Report Completion"
D
.N DIE,DA,DR D
.S DIE="^GMR(120.85,"
.S DA=GMRAPA1,DIE("NO^")="OUTOK"
.S DR="23T;24T;25T;26T;26.1T;31.1;S:X'=""y"" Y=""@1"";27;@1"
.D ^DIE
.Q
I $D(Y) S GMRAOUT=1
I 'GMRAOUT,$P($G(^GMR(120.85,GMRAPA1,"PTC1")),U,10)="y" W @IOF D PN^GMRAPT I GMRAOUT D
.S GMRAOUT=0
.Q
K X,Y
Q:GMRAOUT
D
.N DIE,DA,DR
.S DIE="^GMR(120.85,"
.S DA=GMRAPA1,DIE("NO^")="OUTOK"
.;S DR="31.2;S:X'=""y"" Y=""@2"";28;S:'X Y=""@2"";29;@2;31.3;S:X'=""y"" Y=""@3"";30;@3"
.S DR="31.2;S:X'=""y"" Y=""@2"";28;S:'X Y=""@2"";29;@2"
.D ^DIE
.Q
I $D(Y) S GMRAOUT=1
Q:GMRAOUT
W ! D DISP,EDIT Q:GMRAOUT
D UNLOCK^GMRAUTL(120.85,GMRAPA1)
G EN1
Q
DISP ;DISPLAY AND EDIT COMMENTS
S GMRAOUT=0
I '$O(^GMR(120.85,GMRAPA1,"PTC2",0)) Q
W !,"P&T COMMITTEE ADDENDUM COMMENTS:"
S GMRAX=0 F S GMRAX=$O(^GMR(120.85,GMRAPA1,"PTC2",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
.S GMRAY=$P(^GMR(120.85,GMRAPA1,"PTC2",GMRAX,0),U)
.D PRINT
.Q
Q
PN ;ENTER PROGRESS NOTE FOR A MedWATCH REPORT
D EN1^GMRAPET0($P(GMRAPA(0),U),GMRAPA,"M",.GMRAOUT)
D ; Execute the event point for this reaction
.Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
.Q:'$D(GMRAPA1) S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""
.N OROLD,DFN S DFN=$P(GMRAPA(0),U)
.D INP^VADPT S X=$O(^ORD(101,"B","GMRA MEDWATCH DATA COMPLETE",0))_";ORD(101," D EN^XQOR:X K VAIN,X
.Q
Q
PRINT ;PRINT OUT THE DATA
W !!,"Date: ",$$DATE^GMRAUTL1(GMRAY)
I '$D(^GMR(120.85,GMRAPA1,"PTC2",GMRAX,1,0)) Q
S DIWL=5,DIWR=75,DIWF=""
K ^UTILITY($J,"W",DIWL)
S GMRAXX=0 F S GMRAXX=$O(^GMR(120.85,GMRAPA1,"PTC2",GMRAX,1,GMRAXX)) Q:GMRAXX<1 S X=^(GMRAXX,0) D ^DIWP
S GMRAXX=0 F S GMRAXX=$O(^UTILITY($J,"W",DIWL,GMRAXX)) Q:GMRAXX<1 D:$Y>(IOSL-3) HEAD Q:GMRAOUT W !,?5,^UTILITY($J,"W",DIWL,GMRAXX,0)
Q
HEAD ;
W !,"Press RETURN to continue or ""^"" to stop display or ""^^"" to QUIT: "
R X:DTIME S:'$T X="^^" S GMRAOUT=$S(X="^^":2,X="^":1,1:0) I "^^"[X K X W @IOF Q
W !,"ENTER 'RETURN' TO CONTINUE '^' TO STOP LISTING OR '^^' TO QUIT",$C(7)
G HEAD
Q
EDIT ;EDIT PT COMMENTS
Q:GMRAOUT=2
S GMRAOUT=0
I '$D(^GMR(120.85,GMRAPA1,"PTC2",0)) S ^(0)="^120.85315D^^"
D NOW^%DTC S DIC="^GMR(120.85,"_GMRAPA1_",""PTC2"",",DLAYGO=120.85,DA(1)=GMRAPA1,DIC(0)="L",X=% K DD,DO,DINUM D FILE^DICN K DLAYGO G EXIT:+Y'>0
S DA=+Y,DIE=DIC,DR="1" K DIC D ^DIE S:$D(Y) GMRAOUT=1
I '$O(^GMR(120.85,DA(1),"PTC2",DA,1,0)) S DIK=DIE D ^DIK
Q
EXIT ; EXIT OF ROUTINE
D:$D(GMRAPA1) UNLOCK^GMRAUTL(120.85,GMRAPA1)
EXIT1 ;EXIT IF NOT LOCKED
K ^TMP($J),^TMP("GMRA",$J)
D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPT 3147 printed Nov 22, 2024@16:50:35 Page 2
GMRAPT ;HIRMFO/WAA-P&T COMMITTEE COMPLETION SYSTEM ;12/1/95 14:45
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; Entry for ENTER/EDIT P&T COMMITTEE DATA option
+1 DO MAIN
+2 DO EXIT
+3 QUIT
MAIN ;MAIN STARTING POINT
+1 SET GMRAOUT=0
SET GMRALAGO=1
DO EN1^GMRAU85
if GMRAPA1<1
GOTO EXIT1
+2 SET GMRAPA=0
DO ^GMRADSP7
+3 ;v=New line
+4 IF $PIECE(GMRAPA(0),U,20)'["D"
WRITE !,"YOU CAN ONLY EDIT OBSERVED DRUG REACTIONS",!
QUIT
+5 ;V=Old line
+6 ;I $P(GMRAPA(0),U,20)'["D"!($P(GMRAPA(0),U,6)'="o") W !,"YOU CAN ONLY EDIT OBSERVED DRUG REACTIONS",! Q
REP1 WRITE @IOF,!,"P&T Report Completion"
+1 Begin DoDot:1
+2 NEW DIE,DA,DR
Begin DoDot:2
End DoDot:2
+3 SET DIE="^GMR(120.85,"
+4 SET DA=GMRAPA1
SET DIE("NO^")="OUTOK"
+5 SET DR="23T;24T;25T;26T;26.1T;31.1;S:X'=""y"" Y=""@1"";27;@1"
+6 DO ^DIE
+7 QUIT
End DoDot:1
+8 IF $DATA(Y)
SET GMRAOUT=1
+9 IF 'GMRAOUT
IF $PIECE($GET(^GMR(120.85,GMRAPA1,"PTC1")),U,10)="y"
WRITE @IOF
DO PN^GMRAPT
IF GMRAOUT
Begin DoDot:1
+10 SET GMRAOUT=0
+11 QUIT
End DoDot:1
+12 KILL X,Y
+13 if GMRAOUT
QUIT
+14 Begin DoDot:1
+15 NEW DIE,DA,DR
+16 SET DIE="^GMR(120.85,"
+17 SET DA=GMRAPA1
SET DIE("NO^")="OUTOK"
+18 ;S DR="31.2;S:X'=""y"" Y=""@2"";28;S:'X Y=""@2"";29;@2;31.3;S:X'=""y"" Y=""@3"";30;@3"
+19 SET DR="31.2;S:X'=""y"" Y=""@2"";28;S:'X Y=""@2"";29;@2"
+20 DO ^DIE
+21 QUIT
End DoDot:1
+22 IF $DATA(Y)
SET GMRAOUT=1
+23 if GMRAOUT
QUIT
+24 WRITE !
DO DISP
DO EDIT
if GMRAOUT
QUIT
+25 DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
+26 GOTO EN1
+27 QUIT
DISP ;DISPLAY AND EDIT COMMENTS
+1 SET GMRAOUT=0
+2 IF '$ORDER(^GMR(120.85,GMRAPA1,"PTC2",0))
QUIT
+3 WRITE !,"P&T COMMITTEE ADDENDUM COMMENTS:"
+4 SET GMRAX=0
FOR
SET GMRAX=$ORDER(^GMR(120.85,GMRAPA1,"PTC2",GMRAX))
if GMRAX<1
QUIT
Begin DoDot:1
+5 SET GMRAY=$PIECE(^GMR(120.85,GMRAPA1,"PTC2",GMRAX,0),U)
+6 DO PRINT
+7 QUIT
End DoDot:1
if GMRAOUT
QUIT
+8 QUIT
PN ;ENTER PROGRESS NOTE FOR A MedWATCH REPORT
+1 DO EN1^GMRAPET0($PIECE(GMRAPA(0),U),GMRAPA,"M",.GMRAOUT)
+2 ; Execute the event point for this reaction
Begin DoDot:1
+3 if '$DATA(GMRAPA)
QUIT
SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+4 if '$DATA(GMRAPA1)
QUIT
SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))
if GMRAPA1(0)=""
QUIT
+5 NEW OROLD,DFN
SET DFN=$PIECE(GMRAPA(0),U)
+6 DO INP^VADPT
SET X=$ORDER(^ORD(101,"B","GMRA MEDWATCH DATA COMPLETE",0))_";ORD(101,"
if X
DO EN^XQOR
KILL VAIN,X
+7 QUIT
End DoDot:1
+8 QUIT
PRINT ;PRINT OUT THE DATA
+1 WRITE !!,"Date: ",$$DATE^GMRAUTL1(GMRAY)
+2 IF '$DATA(^GMR(120.85,GMRAPA1,"PTC2",GMRAX,1,0))
QUIT
+3 SET DIWL=5
SET DIWR=75
SET DIWF=""
+4 KILL ^UTILITY($JOB,"W",DIWL)
+5 SET GMRAXX=0
FOR
SET GMRAXX=$ORDER(^GMR(120.85,GMRAPA1,"PTC2",GMRAX,1,GMRAXX))
if GMRAXX<1
QUIT
SET X=^(GMRAXX,0)
DO ^DIWP
+6 SET GMRAXX=0
FOR
SET GMRAXX=$ORDER(^UTILITY($JOB,"W",DIWL,GMRAXX))
if GMRAXX<1
QUIT
if $Y>(IOSL-3)
DO HEAD
if GMRAOUT
QUIT
WRITE !,?5,^UTILITY($JOB,"W",DIWL,GMRAXX,0)
+7 QUIT
HEAD ;
+1 WRITE !,"Press RETURN to continue or ""^"" to stop display or ""^^"" to QUIT: "
+2 READ X:DTIME
if '$TEST
SET X="^^"
SET GMRAOUT=$SELECT(X="^^":2,X="^":1,1:0)
IF "^^"[X
KILL X
WRITE @IOF
QUIT
+3 WRITE !,"ENTER 'RETURN' TO CONTINUE '^' TO STOP LISTING OR '^^' TO QUIT",$CHAR(7)
+4 GOTO HEAD
+5 QUIT
EDIT ;EDIT PT COMMENTS
+1 if GMRAOUT=2
QUIT
+2 SET GMRAOUT=0
+3 IF '$DATA(^GMR(120.85,GMRAPA1,"PTC2",0))
SET ^(0)="^120.85315D^^"
+4 DO NOW^%DTC
SET DIC="^GMR(120.85,"_GMRAPA1_",""PTC2"","
SET DLAYGO=120.85
SET DA(1)=GMRAPA1
SET DIC(0)="L"
SET X=%
KILL DD,DO,DINUM
DO FILE^DICN
KILL DLAYGO
if +Y'>0
GOTO EXIT
+5 SET DA=+Y
SET DIE=DIC
SET DR="1"
KILL DIC
DO ^DIE
if $DATA(Y)
SET GMRAOUT=1
+6 IF '$ORDER(^GMR(120.85,DA(1),"PTC2",DA,1,0))
SET DIK=DIE
DO ^DIK
+7 QUIT
EXIT ; EXIT OF ROUTINE
+1 if $DATA(GMRAPA1)
DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
EXIT1 ;EXIT IF NOT LOCKED
+1 KILL ^TMP($JOB),^TMP("GMRA",$JOB)
+2 DO KILL^XUSCLEAN
+3 QUIT
