- GMRADSP3 ;HIRMFO/YMP,RM,WAA-PRINT PATIENT A/AR ; 8/16/92
- ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
- EN1 ;
- S:'$D(GMRAOTH) GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
- S GMRASP(1)="",GMRASP(2)="" D WRITE Q:GMRAOUT
- S GMRAREA=0,GMRAFT=1
- I $G(GMRAVFY,0) S GMRAHDR(1)=" SIGNS/SYMPTOMS: ",GMRASP(1)=0
- E S GMRAHDR(1)="SIGNS/SYMPTOMS: ",GMRASP(1)=0
- F S GMRAREA=$O(^GMR(120.8,GMRAPA,10,GMRAREA)) Q:GMRAREA<1 D Q:GMRAOUT
- .N GMRAX,GMRAZ
- .S GMRAX=$G(^GMR(120.8,GMRAPA,10,GMRAREA,0))
- .Q:GMRAX=""
- .I +GMRAX'=GMRAOTH S GMRALIN(1)=$E($S($D(^GMRD(120.83,+GMRAX,0)):$P(^(0),U),1:""),1,23)
- .E S GMRALIN(1)=$P(GMRAX,U,2)
- .S GMRAZ=$S($P(GMRAX,U,4)'="":$$FMTE^XLFDT($P(GMRAX,U,4),1),1:"")
- .S:GMRAZ'="" GMRALIN(1)=GMRALIN(1)_" ("_GMRAZ_")"
- .I $G(GMRAVFY,0),GMRAHDR(1)="" S GMRALIN(1)=" "_GMRALIN(1)
- .D WRITE S GMRASP(1)=16,GMRAHDR(1)=""
- .Q
- Q:$G(GMRAVFY,0) ; Indicates this routine was run from verify part ART
- ENDING ;
- S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
- G:$P(GMRAPA(0),U,14)="" SEVERE
- S GMRASP(1)=5,GMRAHDR(1)="MECHANISM: ",GMRALIN(1)=$S($P(GMRAPA(0),U,14)="A":"ALLERGY",$P(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$P(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")
- D WRITE Q:GMRAOUT
- SEVERE ;
- I $P(GMRAPA(0),U,16)'=1 G ERROR
- S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
- S GMRASP(1)=6,GMRAHDR(1)="VERIFIER: "
- S GMRALIN(1)=$S($P(GMRAPA(0),U,18)="":"",$D(^VA(200,+$P(GMRAPA(0),U,18),0)):$P(^(0),U),1:"") I GMRALIN(1)="",$P(GMRAPA(0),U,16)=1 S GMRALIN(1)="AUTOVERIFIED"
- S GMRASP(2)=48,GMRAHDR(2)="VERIFIED: ",Y=$P(GMRAPA(0),U,17) D:Y D^DIQ S GMRALIN(2)=Y
- D WRITE G:GMRAOUT EXIT
- I ($Y+4)>IOSL D EOP G:GMRAOUT EXIT
- D DISP1^GMRAPEM1(GMRAPA,"V",.GMRAOUT) G:GMRAOUT EXIT
- ERROR ;
- G:'GMRAERR EXIT
- S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
- S GMRASP(1)=1,GMRAHDR(1)="USER ENTERING",GMRALIN(1)="",GMRASP(2)=45,GMRAHDR(2)="D/T ENTERED",GMRALIN(2)="" D WRITE Q:GMRAOUT
- S GMRASP(1)=6,GMRAHDR(1)="IN ERROR: ",GMRANAME=$S($D(^GMR(120.8,GMRAPA,"ER")):$P(^("ER"),U,3),1:"")
- S GMRALIN(1)=$S(GMRANAME="":"",$D(^VA(200,+GMRANAME,0)):$P(^(0),U),1:"")
- S GMRASP(2)=48,GMRAHDR(2)="IN ERROR: ",Y=$S($D(^GMR(120.8,GMRAPA,"ER")):$P(^("ER"),U,2),1:"") D:Y D^DIQ S GMRALIN(2)=Y D WRITE Q:GMRAOUT
- I ($Y+4)>IOSL D EOP G:GMRAOUT EXIT
- D DISP1^GMRAPEM1(GMRAPA,"E",.GMRAOUT) G:GMRAOUT EXIT
- EXIT ;
- I $G(GMRAPRNT) S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
- I $G(GMRAPRNT),$O(GMRARRAY(GMRAAL))'=""!($O(GMRARRAY(GMRAAL,GMRAPA))'="") S GMRASP(1)=3,GMRAHDR(1)="",GMRALIN(1)="",$P(GMRALIN(1),"-",21)="",GMRASP(2)="" D WRITE Q:GMRAOUT
- Q
- WRITE ; WRITE THE NEXT LINE OF THE REPORT
- S GMRAFT=0 W:GMRASP(1)'=""!GMRASP(2)'="" ! F X=1:1:2 W:GMRASP(X)'="" ?GMRASP(X),GMRAHDR(X),GMRALIN(X)
- Q:$Y+3'>IOSL
- EOP ; END OF PAGE
- D ENDPG Q:GMRAOUT
- HDR ; PRINT HEADER FOR REPORT
- I $E(IOST)="C" W @IOF
- E W:GMRAPG @IOF
- I $G(GMRAPG)'="" S GMRAPG=GMRAPG+1
- S GMRAFT=1
- F X=0:0 S X=$O(GMRAHEAD(X)) Q:X'>0 W !,GMRAHEAD(X)
- I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
- Q
- ENDPG ;HANDLE EOP
- I $E(IOST)="C" D Q:GMRAOUT
- .K DIR S DIR(0)="E" D ^DIR K DIR
- .S:'+Y GMRAOUT=1
- .Q
- I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADSP3 3207 printed Jan 18, 2025@02:40:08 Page 2
- GMRADSP3 ;HIRMFO/YMP,RM,WAA-PRINT PATIENT A/AR ; 8/16/92
- +1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
- EN1 ;
- +1 if '$DATA(GMRAOTH)
- SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
- +2 SET GMRASP(1)=""
- SET GMRASP(2)=""
- DO WRITE
- if GMRAOUT
- QUIT
- +3 SET GMRAREA=0
- SET GMRAFT=1
- +4 IF $GET(GMRAVFY,0)
- SET GMRAHDR(1)=" SIGNS/SYMPTOMS: "
- SET GMRASP(1)=0
- +5 IF '$TEST
- SET GMRAHDR(1)="SIGNS/SYMPTOMS: "
- SET GMRASP(1)=0
- +6 FOR
- SET GMRAREA=$ORDER(^GMR(120.8,GMRAPA,10,GMRAREA))
- if GMRAREA<1
- QUIT
- Begin DoDot:1
- +7 NEW GMRAX,GMRAZ
- +8 SET GMRAX=$GET(^GMR(120.8,GMRAPA,10,GMRAREA,0))
- +9 if GMRAX=""
- QUIT
- +10 IF +GMRAX'=GMRAOTH
- SET GMRALIN(1)=$EXTRACT($SELECT($DATA(^GMRD(120.83,+GMRAX,0)):$PIECE(^(0),U),1:""),1,23)
- +11 IF '$TEST
- SET GMRALIN(1)=$PIECE(GMRAX,U,2)
- +12 SET GMRAZ=$SELECT($PIECE(GMRAX,U,4)'="":$$FMTE^XLFDT($PIECE(GMRAX,U,4),1),1:"")
- +13 if GMRAZ'=""
- SET GMRALIN(1)=GMRALIN(1)_" ("_GMRAZ_")"
- +14 IF $GET(GMRAVFY,0)
- IF GMRAHDR(1)=""
- SET GMRALIN(1)=" "_GMRALIN(1)
- +15 DO WRITE
- SET GMRASP(1)=16
- SET GMRAHDR(1)=""
- +16 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +17 ; Indicates this routine was run from verify part ART
- if $GET(GMRAVFY,0)
- QUIT
- ENDING ;
- +1 SET (GMRASP(1),GMRASP(2))=""
- DO WRITE
- if GMRAOUT
- QUIT
- +2 if $PIECE(GMRAPA(0),U,14)=""
- GOTO SEVERE
- +3 SET GMRASP(1)=5
- SET GMRAHDR(1)="MECHANISM: "
- SET GMRALIN(1)=$SELECT($PIECE(GMRAPA(0),U,14)="A":"ALLERGY",$PIECE(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$PIECE(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")
- +4 DO WRITE
- if GMRAOUT
- QUIT
- SEVERE ;
- +1 IF $PIECE(GMRAPA(0),U,16)'=1
- GOTO ERROR
- +2 SET (GMRASP(1),GMRASP(2))=""
- DO WRITE
- if GMRAOUT
- QUIT
- +3 SET GMRASP(1)=6
- SET GMRAHDR(1)="VERIFIER: "
- +4 SET GMRALIN(1)=$SELECT($PIECE(GMRAPA(0),U,18)="":"",$DATA(^VA(200,+$PIECE(GMRAPA(0),U,18),0)):$PIECE(^(0),U),1:"")
- IF GMRALIN(1)=""
- IF $PIECE(GMRAPA(0),U,16)=1
- SET GMRALIN(1)="AUTOVERIFIED"
- +5 SET GMRASP(2)=48
- SET GMRAHDR(2)="VERIFIED: "
- SET Y=$PIECE(GMRAPA(0),U,17)
- if Y
- DO D^DIQ
- SET GMRALIN(2)=Y
- +6 DO WRITE
- if GMRAOUT
- GOTO EXIT
- +7 IF ($Y+4)>IOSL
- DO EOP
- if GMRAOUT
- GOTO EXIT
- +8 DO DISP1^GMRAPEM1(GMRAPA,"V",.GMRAOUT)
- if GMRAOUT
- GOTO EXIT
- ERROR ;
- +1 if 'GMRAERR
- GOTO EXIT
- +2 SET (GMRASP(1),GMRASP(2))=""
- DO WRITE
- if GMRAOUT
- QUIT
- +3 SET GMRASP(1)=1
- SET GMRAHDR(1)="USER ENTERING"
- SET GMRALIN(1)=""
- SET GMRASP(2)=45
- SET GMRAHDR(2)="D/T ENTERED"
- SET GMRALIN(2)=""
- DO WRITE
- if GMRAOUT
- QUIT
- +4 SET GMRASP(1)=6
- SET GMRAHDR(1)="IN ERROR: "
- SET GMRANAME=$SELECT($DATA(^GMR(120.8,GMRAPA,"ER")):$PIECE(^("ER"),U,3),1:"")
- +5 SET GMRALIN(1)=$SELECT(GMRANAME="":"",$DATA(^VA(200,+GMRANAME,0)):$PIECE(^(0),U),1:"")
- +6 SET GMRASP(2)=48
- SET GMRAHDR(2)="IN ERROR: "
- SET Y=$SELECT($DATA(^GMR(120.8,GMRAPA,"ER")):$PIECE(^("ER"),U,2),1:"")
- if Y
- DO D^DIQ
- SET GMRALIN(2)=Y
- DO WRITE
- if GMRAOUT
- QUIT
- +7 IF ($Y+4)>IOSL
- DO EOP
- if GMRAOUT
- GOTO EXIT
- +8 DO DISP1^GMRAPEM1(GMRAPA,"E",.GMRAOUT)
- if GMRAOUT
- GOTO EXIT
- EXIT ;
- +1 IF $GET(GMRAPRNT)
- SET (GMRASP(1),GMRASP(2))=""
- DO WRITE
- if GMRAOUT
- QUIT
- +2 IF $GET(GMRAPRNT)
- IF $ORDER(GMRARRAY(GMRAAL))'=""!($ORDER(GMRARRAY(GMRAAL,GMRAPA))'="")
- SET GMRASP(1)=3
- SET GMRAHDR(1)=""
- SET GMRALIN(1)=""
- SET $PIECE(GMRALIN(1),"-",21)=""
- SET GMRASP(2)=""
- DO WRITE
- if GMRAOUT
- QUIT
- +3 QUIT
- WRITE ; WRITE THE NEXT LINE OF THE REPORT
- +1 SET GMRAFT=0
- if GMRASP(1)'=""!GMRASP(2)'=""
- WRITE !
- FOR X=1:1:2
- if GMRASP(X)'=""
- WRITE ?GMRASP(X),GMRAHDR(X),GMRALIN(X)
- +2 if $Y+3'>IOSL
- QUIT
- EOP ; END OF PAGE
- +1 DO ENDPG
- if GMRAOUT
- QUIT
- HDR ; PRINT HEADER FOR REPORT
- +1 IF $EXTRACT(IOST)="C"
- WRITE @IOF
- +2 IF '$TEST
- if GMRAPG
- WRITE @IOF
- +3 IF $GET(GMRAPG)'=""
- SET GMRAPG=GMRAPG+1
- +4 SET GMRAFT=1
- +5 FOR X=0:0
- SET X=$ORDER(GMRAHEAD(X))
- if X'>0
- QUIT
- WRITE !,GMRAHEAD(X)
- +6 ; Check if stopped by user
- IF $DATA(ZTQUEUED)
- if $$STPCK^GMRAUTL1
- SET GMRAOUT=1
- +7 QUIT
- ENDPG ;HANDLE EOP
- +1 IF $EXTRACT(IOST)="C"
- Begin DoDot:1
- +2 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +3 if '+Y
- SET GMRAOUT=1
- +4 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +5 ; Check if stopped by user
- IF $DATA(ZTQUEUED)
- if $$STPCK^GMRAUTL1
- SET GMRAOUT=1
- +6 QUIT