GMRACMR4 ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;10/1/92
;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
EN1 ;This is the main entry point for this program
D EN1^GMRACMR G:GMRAOUT EXIT
DEV ; *** Select output device, force queuing
S GMRAZIS=""
S:GMRASEL'="1," GMRAZIS="Q"
W !! D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
I $D(IO("Q")) D G EXIT
. K IO("Q")
. S ZTRTN="ENTSK^GMRACMR4"
. S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")=""
. S ZTDESC="List of patients without ID band or Chart marked"
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
. Q
E D ENTSK
Q
ENTSK U IO
D EN1^GMRACMR2,EN1^GMRACMR3
S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y)
D SITE^GMRAUTL S GMRASITE=$G(^GMRD(120.84,GMRASITE,0))
D PRINT
G EXIT
PRINT ;PRINT THE DATE
D PRE^GMRAPNA
S GMRAHLOC="" F S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC="" S GMRAX=0 Q:GMRAOUT F S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
.S GMRA=^TMP($J,"GMRAWC",GMRAX)
.D HEAD Q:GMRAOUT
.W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U)
.S GMRACNT=0
.S GMRADATE=0 F S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE)) Q:GMRADATE="" S (GMRAFLG,GMRADFN)=0 F S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1 D Q:GMRAOUT
..Q:'$$PRDTST^GMRAUTL1(GMRADFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
..S GMRAI=0 F S GMRAI=$O(^GMR(120.8,"B",GMRADFN,GMRAI)) Q:GMRAI<1 D Q:GMRAOUT
...Q:'$D(^GMR(120.8,GMRAI,0)) Q:$P($G(^GMR(120.86,GMRADFN,0)),U,2)'=1
...Q:$D(^GMR(120.8,GMRAI,"ER"))
...Q:$P(^GMR(120.8,GMRAI,0),U,2)=""
...S (GMRA("C"),GMRA("I"),GMRA("M"))=1
...I '$O(^GMR(120.8,GMRAI,13,0)) S (GMRA("C"),GMRA("M"))=0
...I GMRA'="W",GMRA("M") Q
...I GMRA="W",$P(GMRASITE,U,5)'=0,'$$IDMARK^GMRACMR5(GMRADFN,GMRADATE,GMRAI) S (GMRA("I"),GMRA("M"))=0
...I GMRA("M") Q
...S GMRACNT=GMRACNT+1
...W ! I GMRAFLG'=GMRADFN W $E($P(^DPT(GMRADFN,0),U),1,30) S (DFN,GMRAFLG)=GMRADFN S GMRAPID="" D VAD^GMRAUTL1(GMRADFN,"","","","","","","",.GMRAPID) W ?30,GMRAPID K GMRAPID
...W ?45,$E($P(^GMR(120.8,GMRAI,0),U,2),1,20)
...I GMRA="W" W ?66,$S(('GMRA("C")&'GMRA("I")):"ID BAND/CHART",('GMRA("C")):"CHART",('GMRA("I")):"ID BAND",1:"ERROR")
...E W ?66,$S('GMRA("C"):"CHART",1:"ERROR")
...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
...Q
..Q
.D NOPAT^GMRAPNA
.Q
D CLOSE^GMRAUTL
Q
HEAD ;HEADER PAGE FOR PRINTOUT
S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF
I $E(IOST,1)="C",GMRAPAGE'=1 D Q:GMRAOUT
.S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
.K Y
.Q
W:GMRAPAGE'=1 @IOF
W !,GMRAPDT,?22,"PATIENTS WITH UNMARKED ID BAND/CHART",?70,"PAGE ",GMRAPAGE
I GMRASEL["1" S GMRATL="CURRENT INPATIENTS"
I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS")
I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS")
W !,?(40-($L(GMRATL)/2)),GMRATL
I (GMRASEL["2"!(GMRASEL["3")) W !,?22,"FROM ",$$DATE^GMRAUTL1(GMRAST),?43,"TO ",$$DATE^GMRAUTL1(GMRAED)
W !!,"PATIENT",?30,"SSN",?45,"ALLERGY",?66,"UNMARKED"
W !,$$REPEAT^XLFSTR("-",79)
I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
Q
EXIT ;
K ^TMP($J,"GMRAWC")
D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRACMR4 3358 printed Nov 22, 2024@16:48:59 Page 2
GMRACMR4 ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;10/1/92
+1 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
EN1 ;This is the main entry point for this program
+1 DO EN1^GMRACMR
if GMRAOUT
GOTO EXIT
DEV ; *** Select output device, force queuing
+1 SET GMRAZIS=""
+2 if GMRASEL'="1,"
SET GMRAZIS="Q"
+3 WRITE !!
DO DEV^GMRAUTL
IF POP
SET GMRAOUT=1
GOTO EXIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 KILL IO("Q")
+6 SET ZTRTN="ENTSK^GMRACMR4"
+7 SET ZTSAVE("GMRA*")=""
SET ZTSAVE("^TMP($J,")=""
+8 SET ZTDESC="List of patients without ID band or Chart marked"
+9 DO ^%ZTLOAD
+10 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
+11 QUIT
End DoDot:1
GOTO EXIT
+12 IF '$TEST
DO ENTSK
+13 QUIT
ENTSK USE IO
+1 DO EN1^GMRACMR2
DO EN1^GMRACMR3
+2 SET GMRAPAGE=0
SET X="NOW"
DO ^%DT
SET GMRAPDT=$$DATE^GMRAUTL1(Y)
+3 DO SITE^GMRAUTL
SET GMRASITE=$GET(^GMRD(120.84,GMRASITE,0))
+4 DO PRINT
+5 GOTO EXIT
PRINT ;PRINT THE DATE
+1 DO PRE^GMRAPNA
+2 SET GMRAHLOC=""
FOR
SET GMRAHLOC=$ORDER(^TMP($JOB,"GMRAWC","C",GMRAHLOC))
if GMRAHLOC=""
QUIT
SET GMRAX=0
if GMRAOUT
QUIT
FOR
SET GMRAX=$ORDER(^(GMRAHLOC,GMRAX))
if GMRAX<1
QUIT
Begin DoDot:1
+3 SET GMRA=^TMP($JOB,"GMRAWC",GMRAX)
+4 DO HEAD
if GMRAOUT
QUIT
+5 WRITE !!,?10,$SELECT(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$PIECE(^SC(GMRAX,0),U)
+6 SET GMRACNT=0
+7 SET GMRADATE=0
FOR
SET GMRADATE=$ORDER(^TMP($JOB,"GMRAWC",GMRAX,GMRADATE))
if GMRADATE=""
QUIT
SET (GMRAFLG,GMRADFN)=0
FOR
SET GMRADFN=$ORDER(^TMP($JOB,"GMRAWC",GMRAX,GMRADATE,GMRADFN))
if GMRADFN<1
QUIT
Begin DoDot:2
+8 ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
if '$$PRDTST^GMRAUTL1(GMRADFN)
QUIT
+9 SET GMRAI=0
FOR
SET GMRAI=$ORDER(^GMR(120.8,"B",GMRADFN,GMRAI))
if GMRAI<1
QUIT
Begin DoDot:3
+10 if '$DATA(^GMR(120.8,GMRAI,0))
QUIT
if $PIECE($GET(^GMR(120.86,GMRADFN,0)),U,2)'=1
QUIT
+11 if $DATA(^GMR(120.8,GMRAI,"ER"))
QUIT
+12 if $PIECE(^GMR(120.8,GMRAI,0),U,2)=""
QUIT
+13 SET (GMRA("C"),GMRA("I"),GMRA("M"))=1
+14 IF '$ORDER(^GMR(120.8,GMRAI,13,0))
SET (GMRA("C"),GMRA("M"))=0
+15 IF GMRA'="W"
IF GMRA("M")
QUIT
+16 IF GMRA="W"
IF $PIECE(GMRASITE,U,5)'=0
IF '$$IDMARK^GMRACMR5(GMRADFN,GMRADATE,GMRAI)
SET (GMRA("I"),GMRA("M"))=0
+17 IF GMRA("M")
QUIT
+18 SET GMRACNT=GMRACNT+1
+19 WRITE !
IF GMRAFLG'=GMRADFN
WRITE $EXTRACT($PIECE(^DPT(GMRADFN,0),U),1,30)
SET (DFN,GMRAFLG)=GMRADFN
SET GMRAPID=""
DO VAD^GMRAUTL1(GMRADFN,"","","","","","","",.GMRAPID)
WRITE ?30,GMRAPID
KILL GMRAPID
+20 WRITE ?45,$EXTRACT($PIECE(^GMR(120.8,GMRAI,0),U,2),1,20)
+21 IF GMRA="W"
WRITE ?66,$SELECT(('GMRA("C")&'GMRA("I")):"ID BAND/CHART",('GMRA("C")):"CHART",('GMRA("I")):"ID BAND",1:"ERROR")
+22 IF '$TEST
WRITE ?66,$SELECT('GMRA("C"):"CHART",1:"ERROR")
+23 IF $Y>(IOSL-4)
DO HEAD
if GMRAOUT
QUIT
+24 QUIT
End DoDot:3
if GMRAOUT
QUIT
+25 QUIT
End DoDot:2
if GMRAOUT
QUIT
+26 DO NOPAT^GMRAPNA
+27 QUIT
End DoDot:1
if GMRAOUT
QUIT
+28 DO CLOSE^GMRAUTL
+29 QUIT
HEAD ;HEADER PAGE FOR PRINTOUT
+1 SET GMRAPAGE=GMRAPAGE+1
SET GMRATL=""
IF $EXTRACT(IOST,1)="C"
IF GMRAPAGE=1
WRITE @IOF
+2 IF $EXTRACT(IOST,1)="C"
IF GMRAPAGE'=1
Begin DoDot:1
+3 SET DIR(0)="E"
DO ^DIR
IF 'Y
SET GMRAOUT=1
+4 KILL Y
+5 QUIT
End DoDot:1
if GMRAOUT
QUIT
+6 if GMRAPAGE'=1
WRITE @IOF
+7 WRITE !,GMRAPDT,?22,"PATIENTS WITH UNMARKED ID BAND/CHART",?70,"PAGE ",GMRAPAGE
+8 IF GMRASEL["1"
SET GMRATL="CURRENT INPATIENTS"
+9 IF GMRASEL["2"
SET GMRATL=$SELECT(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS")
+10 IF GMRASEL["3"
SET GMRATL=$SELECT(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS")
+11 WRITE !,?(40-($LENGTH(GMRATL)/2)),GMRATL
+12 IF (GMRASEL["2"!(GMRASEL["3"))
WRITE !,?22,"FROM ",$$DATE^GMRAUTL1(GMRAST),?43,"TO ",$$DATE^GMRAUTL1(GMRAED)
+13 WRITE !!,"PATIENT",?30,"SSN",?45,"ALLERGY",?66,"UNMARKED"
+14 WRITE !,$$REPEAT^XLFSTR("-",79)
+15 ; Check if stopped by user
IF $DATA(ZTQUEUED)
if $$STPCK^GMRAUTL1
SET GMRAOUT=1
+16 QUIT
EXIT ;
+1 KILL ^TMP($JOB,"GMRAWC")
+2 DO KILL^XUSCLEAN
+3 QUIT
