- GMRADSP4 ;HIRMFO/YMP,RM,WAA,FT-PATIENT'S ALLERGIES PRINTOUT ;7/23/97 09:44
- ;;4.0;Adverse Reaction Tracking;**5,7,8**;Mar 29, 1996
- EN1 ; Entry to PRINT PATIENT REACTION DATA option
- W ! S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: " D ^DIC K DIC,DLAYGO I +Y'>0 S GMRAOUT=1 G EXIT
- S DFN=+Y
- S GMRAEER=$$ERR(DFN)
- I '$D(^GMR(120.86,DFN,0)) W !!,$C(7),"NO ",$S(GMRAEER:"ACTIVE ",1:""),"ALLERGY/ADVERSE REACTION DATA EXISTS FOR THIS PATIENT",! W:GMRAEER "HOWEVER, THERE IS DATA ENTERED IN ERROR ON FILE",! G EN1:'GMRAEER
- I $P($G(^GMR(120.86,DFN,0)),U,2)=0 W !!,$C(7),"PATIENT HAS ANSWERED NKA",$S(GMRAEER:" BUT HAS ""ENTERED IN ERROR"" DATA ON FILE",1:"") G:'GMRAEER EN1 W !
- S GMRAOUT=0,GMRALINE=$$REPEAT^XLFSTR("=",32),GMRASLIN=$$REPEAT^XLFSTR("-",32)
- D DEM^VADPT
- S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTION REPORTS",53)
- S GMRAHEAD(2)=$J($E(VADM(1),1,15),1)_$J(VA("PID"),21)_$J($P(VADM(3),"^",2),24)_$J($S(VADM(4):"("_VADM(4)_")",1:""),5) D KVAR^VADPT K VA S (GMRAHEAD(3),GMRAHEAD(4))="",$P(GMRAHEAD(3),"-",81)=""
- S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
- S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,53)
- DIR1 K DIR S DIR("A",1)="Select 1:DRUG, 2:FOOD, 3:OTHER",DIR(0)="LO^1:3",DIR("A")="Type of allergy"
- E S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
- D ^DIR K DIR
- G:'$D(Y(0)) EN1 S GMRASEL1=Y(0)
- S GMRATTMP="" F X=1:1:3 I GMRASEL1[X S GMRATTMP=GMRATTMP_$E("DFO",X)
- S GMRASEL=GMRATTMP
- K GMRATTMP
- K DIR S DIR("A",1)="Select 1:ACTIVE, 2:ENTERED IN ERROR",DIR(0)="LO^1:2",DIR("A")="Which would you like to see?"
- S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
- D ^DIR K DIR
- G:Y["^"!'$D(Y(0)) EN1 S GMRASEL2=Y(0)
- K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
- I $D(IO("Q")) D TASK G EXIT
- BEGIN K ^TMP($J,"GMRADSP") S GMRANKA=0 F GMRARECN=0:0 S GMRARECN=$O(^GMR(120.8,"B",DFN,GMRARECN)) Q:GMRARECN'>0!GMRAOUT D SET
- G PARSE
- Q
- SET ; SET SORT ARRAY
- S GMRANKA=$P($G(^GMR(120.86,DFN,0)),U,2) I GMRANKA'=1&(GMRASEL2'[2) Q
- S GMRATEMP=^GMR(120.8,GMRARECN,0),GMRAKIND=$P(GMRATEMP,"^",20),GMRAEER=$S(+$G(^GMR(120.8,GMRARECN,"ER")):1,1:0)
- F %=1:1:$L(GMRASEL) I GMRAKIND[$E(GMRASEL,%) Q:'$P(GMRATEMP,"^",12)&'GMRAEER S ^TMP($J,"GMRADSP",GMRAEER,GMRAKIND,$P(GMRATEMP,"^",2),GMRARECN)="" Q
- Q
- PARSE ;
- S GMRAPG=0,GMRAFG=0,GMRACNT=0 D HDR^GMRADSP3
- I 'GMRANKA&(GMRASEL2'[2) W !," This patient has No Known Allergies." Q
- F GMRAZK=1:1:$L(GMRASEL2,",")-1 S GMRACTIV=$S($P(GMRASEL2,",",GMRAZK)=1:0,$P(GMRASEL2,",",GMRAZK)=2:1,1:"") S GMRASTAT=$S(GMRACTIV=0:"ACTIVE",GMRACTIV=1:"E/E",1:"") D:GMRACTIV]"" PARSE2 Q:GMRAOUT
- I 'GMRACNT W !!,"THERE IS NO DATA FOR THIS REPORT."
- EXIT ;Quit and kill
- D CLOSE^GMRAUTL
- K ^TMP($J,"GMRADSP")
- D KILL^XUSCLEAN
- Q
- PARSE2 ;
- S GMRATYP=""
- F S GMRATYP=$O(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP)) Q:GMRATYP="" D PARSECD Q:GMRAOUT
- Q
- PARSECD ;
- W:$D(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP)) !,"STATUS: "_GMRASTAT,!,$E(GMRASLIN,1,$L(GMRASTAT)+8)
- S GMRARES=$$OUTTYPE^GMRAUTL(GMRATYP) W:GMRARES'=""&$D(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP)) !,?2,"TYPE: ",GMRARES,!,?2,$E(GMRALINE,1,6+$L(GMRARES)),!
- S GMRAALL=""
- F GMRAZM=0:0 S GMRAALL=$O(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL)) Q:GMRAALL=""!GMRAOUT D
- . S GMRAREC="" F S GMRAREC=$O(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL,GMRAREC)) Q:GMRAREC=""!GMRAOUT D
- . . S GMRAPA(0)=$G(^GMR(120.8,GMRAREC,0))
- . . S GMRANS="",GMRAPA=GMRAREC,GMRAAL=GMRAALL,GMRACNT=GMRACNT+1
- . . S GMRADRUG=($O(^GMR(120.8,GMRAPA,2,0))!$O(^GMR(120.8,GMRAPA,3,0))!$P(GMRAPA(0),"^",20)["D"!$S($P(GMRAPA(0),"^",3)[";PS":1,$P(GMRAPA(0),"^",3)[120.82:$S($D(^GMRD(120.82,+$P(GMRAPA(0),"^",3),0)):$P(^(0),"^",2)["D",1:0),1:0))
- . . S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",""))
- . . S GMRAPRNT=1 U:IO IO D EN1^GMRADSP2
- . . I 'GMRAOUT W !,".............................................................................." S GMRAFG=1
- . . Q
- . Q
- Q
- TASK ;
- S ZTDESC="GMRA Print Complete List of Patient's Reactions",ZTRTN="BEGIN^GMRADSP4",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD
- W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
- K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
- Q
- ERR(DFN) ;Checks to see if patient has entered in error data
- N ERR,NUM
- S NUM=0,ERR=0
- F S NUM=$O(^GMR(120.8,"B",DFN,NUM)) Q:'+NUM S:+$G(^GMR(120.8,NUM,"ER")) ERR=1 Q:ERR
- Q ERR
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADSP4 4448 printed Feb 18, 2025@23:05:18 Page 2
- GMRADSP4 ;HIRMFO/YMP,RM,WAA,FT-PATIENT'S ALLERGIES PRINTOUT ;7/23/97 09:44
- +1 ;;4.0;Adverse Reaction Tracking;**5,7,8**;Mar 29, 1996
- EN1 ; Entry to PRINT PATIENT REACTION DATA option
- +1 WRITE !
- SET DIC="^DPT("
- SET DIC(0)="AEQM"
- SET DIC("A")="Select PATIENT: "
- DO ^DIC
- KILL DIC,DLAYGO
- IF +Y'>0
- SET GMRAOUT=1
- GOTO EXIT
- +2 SET DFN=+Y
- +3 SET GMRAEER=$$ERR(DFN)
- +4 IF '$DATA(^GMR(120.86,DFN,0))
- WRITE !!,$CHAR(7),"NO ",$SELECT(GMRAEER:"ACTIVE ",1:""),"ALLERGY/ADVERSE REACTION DATA EXISTS FOR THIS PATIENT",!
- if GMRAEER
- WRITE "HOWEVER, THERE IS DATA ENTERED IN ERROR ON FILE",!
- if 'GMRAEER
- GOTO EN1
- +5 IF $PIECE($GET(^GMR(120.86,DFN,0)),U,2)=0
- WRITE !!,$CHAR(7),"PATIENT HAS ANSWERED NKA",$SELECT(GMRAEER:" BUT HAS ""ENTERED IN ERROR"" DATA ON FILE",1:"")
- if 'GMRAEER
- GOTO EN1
- WRITE !
- +6 SET GMRAOUT=0
- SET GMRALINE=$$REPEAT^XLFSTR("=",32)
- SET GMRASLIN=$$REPEAT^XLFSTR("-",32)
- +7 DO DEM^VADPT
- +8 SET GMRAHEAD(1)=$JUSTIFY("ALLERGY/ADVERSE REACTION REPORTS",53)
- +9 SET GMRAHEAD(2)=$JUSTIFY($EXTRACT(VADM(1),1,15),1)_$JUSTIFY(VA("PID"),21)_$JUSTIFY($PIECE(VADM(3),"^",2),24)_$JUSTIFY($SELECT(VADM(4):"("_VADM(4)_")",1:""),5)
- DO KVAR^VADPT
- KILL VA
- SET (GMRAHEAD(3),GMRAHEAD(4))=""
- SET $PIECE(GMRAHEAD(3),"-",81)=""
- +10 SET GMRANOW=$$NOW^XLFDT
- SET GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
- +11 SET GMRAHEAD(1.5)=$JUSTIFY("Run Date/Time: "_GMRANOW,53)
- DIR1 KILL DIR
- SET DIR("A",1)="Select 1:DRUG, 2:FOOD, 3:OTHER"
- SET DIR(0)="LO^1:3"
- SET DIR("A")="Type of allergy"
- E SET DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
- +1 DO ^DIR
- KILL DIR
- +2 if '$DATA(Y(0))
- GOTO EN1
- SET GMRASEL1=Y(0)
- +3 SET GMRATTMP=""
- FOR X=1:1:3
- IF GMRASEL1[X
- SET GMRATTMP=GMRATTMP_$EXTRACT("DFO",X)
- +4 SET GMRASEL=GMRATTMP
- +5 KILL GMRATTMP
- +6 KILL DIR
- SET DIR("A",1)="Select 1:ACTIVE, 2:ENTERED IN ERROR"
- SET DIR(0)="LO^1:2"
- SET DIR("A")="Which would you like to see?"
- +7 SET DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
- +8 DO ^DIR
- KILL DIR
- +9 if Y["^"!'$DATA(Y(0))
- GOTO EN1
- SET GMRASEL2=Y(0)
- +10 KILL GMRAZIS
- DO DEV^GMRAUTL
- IF POP
- SET GMRAOUT=1
- GOTO EXIT
- +11 IF $DATA(IO("Q"))
- DO TASK
- GOTO EXIT
- BEGIN KILL ^TMP($JOB,"GMRADSP")
- SET GMRANKA=0
- FOR GMRARECN=0:0
- SET GMRARECN=$ORDER(^GMR(120.8,"B",DFN,GMRARECN))
- if GMRARECN'>0!GMRAOUT
- QUIT
- DO SET
- +1 GOTO PARSE
- +2 QUIT
- SET ; SET SORT ARRAY
- +1 SET GMRANKA=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
- IF GMRANKA'=1&(GMRASEL2'[2)
- QUIT
- +2 SET GMRATEMP=^GMR(120.8,GMRARECN,0)
- SET GMRAKIND=$PIECE(GMRATEMP,"^",20)
- SET GMRAEER=$SELECT(+$GET(^GMR(120.8,GMRARECN,"ER")):1,1:0)
- +3 FOR %=1:1:$LENGTH(GMRASEL)
- IF GMRAKIND[$EXTRACT(GMRASEL,%)
- if '$PIECE(GMRATEMP,"^",12)&'GMRAEER
- QUIT
- SET ^TMP($JOB,"GMRADSP",GMRAEER,GMRAKIND,$PIECE(GMRATEMP,"^",2),GMRARECN)=""
- QUIT
- +4 QUIT
- PARSE ;
- +1 SET GMRAPG=0
- SET GMRAFG=0
- SET GMRACNT=0
- DO HDR^GMRADSP3
- +2 IF 'GMRANKA&(GMRASEL2'[2)
- WRITE !," This patient has No Known Allergies."
- QUIT
- +3 FOR GMRAZK=1:1:$LENGTH(GMRASEL2,",")-1
- SET GMRACTIV=$SELECT($PIECE(GMRASEL2,",",GMRAZK)=1:0,$PIECE(GMRASEL2,",",GMRAZK)=2:1,1:"")
- SET GMRASTAT=$SELECT(GMRACTIV=0:"ACTIVE",GMRACTIV=1:"E/E",1:"")
- if GMRACTIV]""
- DO PARSE2
- if GMRAOUT
- QUIT
- +4 IF 'GMRACNT
- WRITE !!,"THERE IS NO DATA FOR THIS REPORT."
- EXIT ;Quit and kill
- +1 DO CLOSE^GMRAUTL
- +2 KILL ^TMP($JOB,"GMRADSP")
- +3 DO KILL^XUSCLEAN
- +4 QUIT
- PARSE2 ;
- +1 SET GMRATYP=""
- +2 FOR
- SET GMRATYP=$ORDER(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP))
- if GMRATYP=""
- QUIT
- DO PARSECD
- if GMRAOUT
- QUIT
- +3 QUIT
- PARSECD ;
- +1 if $DATA(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP))
- WRITE !,"STATUS: "_GMRASTAT,!,$EXTRACT(GMRASLIN,1,$LENGTH(GMRASTAT)+8)
- +2 SET GMRARES=$$OUTTYPE^GMRAUTL(GMRATYP)
- if GMRARES'=""&$DATA(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP))
- WRITE !,?2,"TYPE: ",GMRARES,!,?2,$EXTRACT(GMRALINE,1,6+$LENGTH(GMRARES)),!
- +3 SET GMRAALL=""
- +4 FOR GMRAZM=0:0
- SET GMRAALL=$ORDER(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL))
- if GMRAALL=""!GMRAOUT
- QUIT
- Begin DoDot:1
- +5 SET GMRAREC=""
- FOR
- SET GMRAREC=$ORDER(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL,GMRAREC))
- if GMRAREC=""!GMRAOUT
- QUIT
- Begin DoDot:2
- +6 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAREC,0))
- +7 SET GMRANS=""
- SET GMRAPA=GMRAREC
- SET GMRAAL=GMRAALL
- SET GMRACNT=GMRACNT+1
- +8 SET GMRADRUG=($ORDER(^GMR(120.8,GMRAPA,2,0))!$ORDER(^GMR(120.8,GMRAPA,3,0))!$PIECE(GMRAPA(0),"^",20)["D"!$SELECT($PIECE(GMRAPA(0),"^",3)[";PS":1,$PIECE(GMRAPA(0),"^",3)[120.82:$SELECT(...
- ... $DATA(^GMRD(120.82,+$PIECE(GMRAPA(0),"^",3),0)):$PIECE(^(0),"^",2)["D",1:0),1:0))
- +9 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",""))
- +10 SET GMRAPRNT=1
- if IO
- USE IO
- DO EN1^GMRADSP2
- +11 IF 'GMRAOUT
- WRITE !,".............................................................................."
- SET GMRAFG=1
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 QUIT
- TASK ;
- +1 SET ZTDESC="GMRA Print Complete List of Patient's Reactions"
- SET ZTRTN="BEGIN^GMRADSP4"
- SET ZTDTH=""
- SET ZTIO=ION
- SET ZTSAVE("GMRA*")=""
- SET ZTSAVE("DFN")=""
- DO ^%ZTLOAD
- +2 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
- +3 KILL ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
- +4 QUIT
- ERR(DFN) ;Checks to see if patient has entered in error data
- +1 NEW ERR,NUM
- +2 SET NUM=0
- SET ERR=0
- +3 FOR
- SET NUM=$ORDER(^GMR(120.8,"B",DFN,NUM))
- if '+NUM
- QUIT
- if +$GET(^GMR(120.8,NUM,"ER"))
- SET ERR=1
- if ERR
- QUIT
- +4 QUIT ERR