- GMRADSP2 ;HIRMFO/RM,WAA-PRINT PATIENT A/AR ;11/13/07 09:31
- ;;4.0;Adverse Reaction Tracking;**21,41**;Mar 29, 1996;Build 8
- EN1 ; ENTRY TO PRINT DATA FOR A SINGLE RECORD DENOTED BY GMRAPA
- S GMRAOUT=0
- S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
- S DFN=$P(GMRAPA(0),"^") D DEM^VADPT S GMRANAM=VADM(1) D KVAR^VADPT K VA
- S GMRADRUG=$S($P(GMRAPA(0),U,20)["D":1,1:0)
- S GMRAERR=$S($D(^GMR(120.8,GMRAPA,"ER")):+^("ER"),1:0) S:'$D(GMRAPG) GMRAPG=0
- D:$Y+3>IOSL EOP^GMRADSP3 G:GMRAOUT EXIT
- ;D:'GMRAPG HDR^GMRADSP3
- I 'GMRAPRNT S GMRASP(1)=7,GMRAHDR(1)="PATIENT: ",GMRALIN(1)=$E(GMRANAM,1,23),GMRASP(2)=41,GMRAHDR(2)="CAUSATIVE AGENT: ",GMRALIN(2)=$E($P(GMRAPA(0),"^",2),1,21) D WRITE^GMRADSP3 G:GMRAOUT EXIT ;21
- I GMRAPRNT S GMRASP(1)=9,GMRAHDR(1)="AGENT: ",GMRALIN(1)=$E($P(GMRAPA(0),"^",2),1,23),GMRASP(2)="" D WRITE^GMRADSP3 G:GMRAOUT EXIT
- G:'GMRADRUG ORIG S (GMRADI,GMRADC)=0,GMRAFT=1
- DICL ;
- S:GMRADI'="" GMRADI=$O(^GMR(120.8,GMRAPA,2,GMRADI)) S:GMRADC'="" GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) G:GMRADI'>0&(GMRADC'>0)&'GMRAFT ORIG
- ;--41-4
- S GMRASP(1)=$S(GMRAFT:3,'GMRADI:"",1:16),GMRAHDR(1)=$S(GMRAFT:"INGREDIENTS: ",1:""),X=$S($D(^GMR(120.8,GMRAPA,2,+GMRADI,0)):^(0),1:"")
- ;S GMRALIN(1)=$E($S($D(^PS(50.416,+X,0)):$P(^(0),"^"),1:""),1,23)
- D ZERO^PSN50P41(+X,"","","ENCAP")
- S GMRALIN(1)=""
- I $G(^TMP($J,"ENCAP",0))>0 S GMRALIN(1)=$E($G(^TMP($J,"ENCAP",X,.01)),1,23)
- K ^TMP($J,"ENCAP")
- ;--41-4
- S GMRASP(2)=$S(GMRAFT:41,'GMRADC:"",1:58),GMRAHDR(2)=$S(GMRAFT:"VA DRUG CLASSES: ",1:""),X=$S($D(^GMR(120.8,GMRAPA,3,+GMRADC,0)):^(0),1:"")
- ;S GMRALIN(2)=$E($S($D(^PS(50.605,+X,0)):$P(^(0),"^",2),1:""),1,21)
- D IEN^PSN50P65(+X,"","ENCAP")
- S GMRALIN(2)=""
- I $G(^TMP($J,"ENCAP",0))>0 S GMRALIN(2)=$E($G(^TMP($J,"ENCAP",X,1)),1,21)
- K ^TMP($J,"ENCAP")
- D WRITE^GMRADSP3 G:GMRAOUT EXIT S GMRAFT=0 G DICL
- ORIG ;
- S GMRAREA=0,GMRATRT=0
- S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT
- S Y=$P(GMRAPA(0),"^",4) S:Y Y=$$FMTE^XLFDT(Y) S GMRASP(1)=4,GMRAHDR(1)="ORIGINATOR: ",GMRALIN(1)=$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01") ;21
- S GMRASP(2)=46,GMRAHDR(2)="ORIGINATED: ",GMRALIN(2)=Y D WRITE^GMRADSP3 G:GMRAOUT EXIT
- S GMRASP(1)=6,GMRAHDR(1)="SIGN OFF: ",GMRALIN(1)=$S($P(GMRAPA(0),"^",12)=1:"YES",1:"NO"),GMRASP(2)=48,GMRAHDR(2)="OBS/HIST: ",GMRALIN(2)=$S($P(GMRAPA(0),"^",6)="o":"OBSERVED",$P(GMRAPA(0),"^",6)="h":"HISTORICAL",1:"")
- D WRITE^GMRADSP3 G:GMRAOUT EXIT
- I $D(^GMR(120.85,"C",GMRAPA)) D ;21
- .S (GMRASP(1),GMRASP(2))="" ;21
- .N GMRAI,SEVER S (GMRAI,SEVER)=0 F S GMRAI=$O(^GMR(120.85,"C",GMRAPA,GMRAI)) Q:'+GMRAI S:+$P(^GMR(120.85,GMRAI,0),U,14)>SEVER SEVER=$P(^(0),U,14) ;21
- .I $G(SEVER) S GMRASP(1)=6,GMRAHDR(1)="SEVERITY: ",GMRALIN(1)=$S(SEVER=1:"MILD",SEVER=2:"MODERATE",1:"SEVERE") ;21
- .S GMRASP(2)=49,GMRAHDR(2)="OBS D/T: ",GMRALIN(2)=$$FMTE^XLFDT($P(^GMR(120.85,$O(^GMR(120.85,"C",GMRAPA,0)),0),U)) ;21
- .D WRITE^GMRADSP3 G:GMRAOUT EXIT ;21
- .Q ;21
- I ($Y+4)>IOSL D EOP^GMRADSP3 G:GMRAOUT EXIT
- D DISP1^GMRAPEM1(GMRAPA,"O",.GMRAOUT) G:GMRAOUT EXIT
- S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT
- S GMRASP(1)=0,GMRAHDR(1)="ID BAND MARKED: ",Y="",Y=$O(^GMR(120.8,GMRAPA,14,"A",Y)),Y=9999999-Y S:Y'=9999999 Y=$$FMTE^XLFDT(Y) S:Y=9999999 Y="" ;21
- S GMRASP(2)=44,GMRALIN(1)=Y,GMRAHDR(2)="CHART MARKED: ",Y="",Y=$O(^GMR(120.8,GMRAPA,13,"A",Y)),Y=9999999-Y S:Y'=9999999 Y=$$FMTE^XLFDT(Y) S:Y=9999999 Y="" S GMRALIN(2)=Y ;21
- D WRITE^GMRADSP3 G:GMRAOUT EXIT
- G RESET
- LINEOUT ;
- S GMRASP(1)=$S(GMRAFT:6,1:16),GMRAHDR(1)=$S(GMRAFT:"COMMENTS: ",1:""),GMRALIN(1)=$S($D(^UTILITY($J,"W",15,+GMRAX,0)):^(0),1:""),GMRASP(2)="" D WRITE^GMRADSP3 G:GMRAOUT EXIT S GMRAFT=0
- Q
- RESET ;
- D ^GMRADSP3
- EXIT K DIWF,DIWL,DIWR,GMRA,GMRADC,GMRADI,GMRAHDR,GMRALIN,GMRASP,GMRAFT,GMRAREA,GMRATRT,GMRAX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADSP2 3795 printed Feb 18, 2025@23:05:16 Page 2
- GMRADSP2 ;HIRMFO/RM,WAA-PRINT PATIENT A/AR ;11/13/07 09:31
- +1 ;;4.0;Adverse Reaction Tracking;**21,41**;Mar 29, 1996;Build 8
- EN1 ; ENTRY TO PRINT DATA FOR A SINGLE RECORD DENOTED BY GMRAPA
- +1 SET GMRAOUT=0
- +2 SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
- +3 SET DFN=$PIECE(GMRAPA(0),"^")
- DO DEM^VADPT
- SET GMRANAM=VADM(1)
- DO KVAR^VADPT
- KILL VA
- +4 SET GMRADRUG=$SELECT($PIECE(GMRAPA(0),U,20)["D":1,1:0)
- +5 SET GMRAERR=$SELECT($DATA(^GMR(120.8,GMRAPA,"ER")):+^("ER"),1:0)
- if '$DATA(GMRAPG)
- SET GMRAPG=0
- +6 if $Y+3>IOSL
- DO EOP^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +7 ;D:'GMRAPG HDR^GMRADSP3
- +8 ;21
- IF 'GMRAPRNT
- SET GMRASP(1)=7
- SET GMRAHDR(1)="PATIENT: "
- SET GMRALIN(1)=$EXTRACT(GMRANAM,1,23)
- SET GMRASP(2)=41
- SET GMRAHDR(2)="CAUSATIVE AGENT: "
- SET GMRALIN(2)=$EXTRACT($PIECE(GMRAPA(0),"^",2),1,21)
- DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +9 IF GMRAPRNT
- SET GMRASP(1)=9
- SET GMRAHDR(1)="AGENT: "
- SET GMRALIN(1)=$EXTRACT($PIECE(GMRAPA(0),"^",2),1,23)
- SET GMRASP(2)=""
- DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +10 if 'GMRADRUG
- GOTO ORIG
- SET (GMRADI,GMRADC)=0
- SET GMRAFT=1
- DICL ;
- +1 if GMRADI'=""
- SET GMRADI=$ORDER(^GMR(120.8,GMRAPA,2,GMRADI))
- if GMRADC'=""
- SET GMRADC=$ORDER(^GMR(120.8,GMRAPA,3,GMRADC))
- if GMRADI'>0&(GMRADC'>0)&'GMRAFT
- GOTO ORIG
- +2 ;--41-4
- +3 SET GMRASP(1)=$SELECT(GMRAFT:3,'GMRADI:"",1:16)
- SET GMRAHDR(1)=$SELECT(GMRAFT:"INGREDIENTS: ",1:"")
- SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,2,+GMRADI,0)):^(0),1:"")
- +4 ;S GMRALIN(1)=$E($S($D(^PS(50.416,+X,0)):$P(^(0),"^"),1:""),1,23)
- +5 DO ZERO^PSN50P41(+X,"","","ENCAP")
- +6 SET GMRALIN(1)=""
- +7 IF $GET(^TMP($JOB,"ENCAP",0))>0
- SET GMRALIN(1)=$EXTRACT($GET(^TMP($JOB,"ENCAP",X,.01)),1,23)
- +8 KILL ^TMP($JOB,"ENCAP")
- +9 ;--41-4
- +10 SET GMRASP(2)=$SELECT(GMRAFT:41,'GMRADC:"",1:58)
- SET GMRAHDR(2)=$SELECT(GMRAFT:"VA DRUG CLASSES: ",1:"")
- SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,3,+GMRADC,0)):^(0),1:"")
- +11 ;S GMRALIN(2)=$E($S($D(^PS(50.605,+X,0)):$P(^(0),"^",2),1:""),1,21)
- +12 DO IEN^PSN50P65(+X,"","ENCAP")
- +13 SET GMRALIN(2)=""
- +14 IF $GET(^TMP($JOB,"ENCAP",0))>0
- SET GMRALIN(2)=$EXTRACT($GET(^TMP($JOB,"ENCAP",X,1)),1,21)
- +15 KILL ^TMP($JOB,"ENCAP")
- +16 DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- SET GMRAFT=0
- GOTO DICL
- ORIG ;
- +1 SET GMRAREA=0
- SET GMRATRT=0
- +2 SET (GMRASP(1),GMRASP(2))=""
- DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +3 ;21
- SET Y=$PIECE(GMRAPA(0),"^",4)
- if Y
- SET Y=$$FMTE^XLFDT(Y)
- SET GMRASP(1)=4
- SET GMRAHDR(1)="ORIGINATOR: "
- SET GMRALIN(1)=$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,5)_",",".01")
- +4 SET GMRASP(2)=46
- SET GMRAHDR(2)="ORIGINATED: "
- SET GMRALIN(2)=Y
- DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +5 SET GMRASP(1)=6
- SET GMRAHDR(1)="SIGN OFF: "
- SET GMRALIN(1)=$SELECT($PIECE(GMRAPA(0),"^",12)=1:"YES",1:"NO")
- SET GMRASP(2)=48
- SET GMRAHDR(2)="OBS/HIST: "
- SET GMRALIN(2)=$SELECT($PIECE(GMRAPA(0),"^",6)="o":"OBSERVED",$PIECE(GMRAPA(0),"^",6)="h":"HISTORICAL",1:"")
- +6 DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +7 ;21
- IF $DATA(^GMR(120.85,"C",GMRAPA))
- Begin DoDot:1
- +8 ;21
- SET (GMRASP(1),GMRASP(2))=""
- +9 ;21
- NEW GMRAI,SEVER
- SET (GMRAI,SEVER)=0
- FOR
- SET GMRAI=$ORDER(^GMR(120.85,"C",GMRAPA,GMRAI))
- if '+GMRAI
- QUIT
- if +$PIECE(^GMR(120.85,GMRAI,0),U,14)>SEVER
- SET SEVER=$PIECE(^(0),U,14)
- +10 ;21
- IF $GET(SEVER)
- SET GMRASP(1)=6
- SET GMRAHDR(1)="SEVERITY: "
- SET GMRALIN(1)=$SELECT(SEVER=1:"MILD",SEVER=2:"MODERATE",1:"SEVERE")
- +11 ;21
- SET GMRASP(2)=49
- SET GMRAHDR(2)="OBS D/T: "
- SET GMRALIN(2)=$$FMTE^XLFDT($PIECE(^GMR(120.85,$ORDER(^GMR(120.85,"C",GMRAPA,0)),0),U))
- +12 ;21
- DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +13 ;21
- QUIT
- End DoDot:1
- +14 IF ($Y+4)>IOSL
- DO EOP^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +15 DO DISP1^GMRAPEM1(GMRAPA,"O",.GMRAOUT)
- if GMRAOUT
- GOTO EXIT
- +16 SET (GMRASP(1),GMRASP(2))=""
- DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +17 ;21
- SET GMRASP(1)=0
- SET GMRAHDR(1)="ID BAND MARKED: "
- SET Y=""
- SET Y=$ORDER(^GMR(120.8,GMRAPA,14,"A",Y))
- SET Y=9999999-Y
- if Y'=9999999
- SET Y=$$FMTE^XLFDT(Y)
- if Y=9999999
- SET Y=""
- +18 ;21
- SET GMRASP(2)=44
- SET GMRALIN(1)=Y
- SET GMRAHDR(2)="CHART MARKED: "
- SET Y=""
- SET Y=$ORDER(^GMR(120.8,GMRAPA,13,"A",Y))
- SET Y=9999999-Y
- if Y'=9999999
- SET Y=$$FMTE^XLFDT(Y)
- if Y=9999999
- SET Y=""
- SET GMRALIN(2)=Y
- +19 DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- +20 GOTO RESET
- LINEOUT ;
- +1 SET GMRASP(1)=$SELECT(GMRAFT:6,1:16)
- SET GMRAHDR(1)=$SELECT(GMRAFT:"COMMENTS: ",1:"")
- SET GMRALIN(1)=$SELECT($DATA(^UTILITY($JOB,"W",15,+GMRAX,0)):^(0),1:"")
- SET GMRASP(2)=""
- DO WRITE^GMRADSP3
- if GMRAOUT
- GOTO EXIT
- SET GMRAFT=0
- +2 QUIT
- RESET ;
- +1 DO ^GMRADSP3
- EXIT KILL DIWF,DIWL,DIWR,GMRA,GMRADC,GMRADI,GMRAHDR,GMRALIN,GMRASP,GMRAFT,GMRAREA,GMRATRT,GMRAX
- +1 QUIT