- 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 Feb 18, 2025@23:05:09 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
