GMRAPNA ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;12/1/95 14:15
;;4.0;Adverse Reaction Tracking;**30,33**;Mar 29, 1996;Build 5
EN1 ; Entry for LIST BY LOCATION OF UNDOCUMENTED ALLERGIES option
D EN1^GMRACMR G:GMRAOUT EXIT
D DEV
D EXIT
Q
DEV ; *** Select output device, force queuing
;***** NOTE: CHECKS TO SEE IF VALID DEVICE IS SELECTED THEN ALL I HAVE TO DO IS RUN TASK MAN.
S GMRAZIS="" S:GMRASEL'="1," GMRAZIS="Q"
W !! D DEV^GMRAUTL I POP G EXIT
I $D(IO("Q")) D G EXIT
. K IO("Q")
. S ZTRTN="ENTSK^GMRAPNA"
. S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")=""
. S ZTDESC="List of patients who have not been asked of allergies"
. 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 PRINT
G EXIT
PRINT ;PRINT THE DATE
D PRE
S GMRAHLOC="" F S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC=""!(GMRAOUT) S GMRAX=0 F S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
.S GMRA=$G(^TMP($J,"GMRAWC",GMRAX)),GMRACNT=0
.I GMRA="" Q
.D HEAD Q:GMRAOUT
.W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U)
.S GMRADATE=0 F S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE)) Q:GMRADATE="" S GMRADFN=0 Q:GMRAOUT F S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1 D Q:GMRAOUT
..I '$D(^GMR(120.86,GMRADFN,0))
..E I +$P(^GMR(120.86,GMRADFN,0),U,4)<$G(GMRAED,9999999) Q
..Q:'$D(^DPT(GMRADFN,0))
..Q:$$DECEASED^GMRAFX(GMRADFN) ;GMRA*4*30 Prevent deceased patients from appearing on this report.
..Q:'$$PRDTST^GMRAUTL1(GMRADFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
..S GMRACNT=GMRACNT+1
..W !,$P(^DPT(GMRADFN,0),U) S DFN=GMRADFN,VAINDT=$S(GMRADATE="CURRENT":DT,1:GMRADATE) D 1^VADPT W ?30,VA("PID") W:GMRA'="C" ?45,$P(VAIN(2),U,2)
..I VAIN(5)'="" W !,?5,"Room/Bed: ",VAIN(5)
..D KVAR^VADPT K VA,DFN
..I $Y>(IOSL-4) D HEAD Q:GMRAOUT
..Q
.D NOPAT
.Q
D CLOSE^GMRAUTL
Q
NOPAT ; If there are no patients print informational message
Q:GMRACNT
W !,?24,"* No Patients for this ",$S(GMRA="W":"Ward",GMRA="M":"Module",GMRA="C":"Clinic",1:"UNKNOWN")," *"
W !
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
I GMRAPAGE'=1 W @IOF
W !,GMRAPDT,?23,"PATIENTS NOT ASKED ABOUT ALLERGIES",?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 !,?23,"FROM ",$$DATE^GMRAUTL1(GMRAST),?42,"TO ",$$DATE^GMRAUTL1(GMRAED)
W !!,"PATIENT",?30,"SSN" W:GMRA'="C" ?45,"PROVIDER"
W !,$$REPEAT^XLFSTR("-",78)
I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
Q
PRE ; This will validate the TMP global and fire off Xref
N GMRAX,GMRAY,GMRAT1,GMRAT2,GMRAT3
Q:'$D(^TMP($J,"GMRAWC"))
S GMRAX=0 F S GMRAX=$O(^TMP($J,"GMRAWC",GMRAX)) Q:GMRAX<1 D
.S GMRAY=^TMP($J,"GMRAWC",GMRAX)
.S GMRAT1=$P($G(^SC(GMRAX,0)),U,2)
.S GMRAT2=$P($G(^SC(GMRAX,0)),U)
.S GMRAT3=$S(GMRAT1'="":GMRAT1,1:GMRAT2)
.S ^TMP($J,"GMRAWC","C",GMRAT3,GMRAX)=""
.Q
Q
EXIT ;
K ^TMP($J,"GMRAWC")
D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPNA 3571 printed Apr 09, 2024@20:44:27 Page 2
GMRAPNA ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;12/1/95 14:15
+1 ;;4.0;Adverse Reaction Tracking;**30,33**;Mar 29, 1996;Build 5
EN1 ; Entry for LIST BY LOCATION OF UNDOCUMENTED ALLERGIES option
+1 DO EN1^GMRACMR
if GMRAOUT
GOTO EXIT
+2 DO DEV
+3 DO EXIT
+4 QUIT
DEV ; *** Select output device, force queuing
+1 ;***** NOTE: CHECKS TO SEE IF VALID DEVICE IS SELECTED THEN ALL I HAVE TO DO IS RUN TASK MAN.
+2 SET GMRAZIS=""
if GMRASEL'="1,"
SET GMRAZIS="Q"
+3 WRITE !!
DO DEV^GMRAUTL
IF POP
GOTO EXIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 KILL IO("Q")
+6 SET ZTRTN="ENTSK^GMRAPNA"
+7 SET ZTSAVE("GMRA*")=""
SET ZTSAVE("^TMP($J,")=""
+8 SET ZTDESC="List of patients who have not been asked of allergies"
+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 PRINT
+4 GOTO EXIT
PRINT ;PRINT THE DATE
+1 DO PRE
+2 SET GMRAHLOC=""
FOR
SET GMRAHLOC=$ORDER(^TMP($JOB,"GMRAWC","C",GMRAHLOC))
if GMRAHLOC=""!(GMRAOUT)
QUIT
SET GMRAX=0
FOR
SET GMRAX=$ORDER(^(GMRAHLOC,GMRAX))
if GMRAX<1
QUIT
Begin DoDot:1
+3 SET GMRA=$GET(^TMP($JOB,"GMRAWC",GMRAX))
SET GMRACNT=0
+4 IF GMRA=""
QUIT
+5 DO HEAD
if GMRAOUT
QUIT
+6 WRITE !!,?10,$SELECT(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$PIECE(^SC(GMRAX,0),U)
+7 SET GMRADATE=0
FOR
SET GMRADATE=$ORDER(^TMP($JOB,"GMRAWC",GMRAX,GMRADATE))
if GMRADATE=""
QUIT
SET GMRADFN=0
if GMRAOUT
QUIT
FOR
SET GMRADFN=$ORDER(^TMP($JOB,"GMRAWC",GMRAX,GMRADATE,GMRADFN))
if GMRADFN<1
QUIT
Begin DoDot:2
+8 IF '$DATA(^GMR(120.86,GMRADFN,0))
+9 IF '$TEST
IF +$PIECE(^GMR(120.86,GMRADFN,0),U,4)<$GET(GMRAED,9999999)
QUIT
+10 if '$DATA(^DPT(GMRADFN,0))
QUIT
+11 ;GMRA*4*30 Prevent deceased patients from appearing on this report.
if $$DECEASED^GMRAFX(GMRADFN)
QUIT
+12 ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
if '$$PRDTST^GMRAUTL1(GMRADFN)
QUIT
+13 SET GMRACNT=GMRACNT+1
+14 WRITE !,$PIECE(^DPT(GMRADFN,0),U)
SET DFN=GMRADFN
SET VAINDT=$SELECT(GMRADATE="CURRENT":DT,1:GMRADATE)
DO 1^VADPT
WRITE ?30,VA("PID")
if GMRA'="C"
WRITE ?45,$PIECE(VAIN(2),U,2)
+15 IF VAIN(5)'=""
WRITE !,?5,"Room/Bed: ",VAIN(5)
+16 DO KVAR^VADPT
KILL VA,DFN
+17 IF $Y>(IOSL-4)
DO HEAD
if GMRAOUT
QUIT
+18 QUIT
End DoDot:2
if GMRAOUT
QUIT
+19 DO NOPAT
+20 QUIT
End DoDot:1
if GMRAOUT
QUIT
+21 DO CLOSE^GMRAUTL
+22 QUIT
NOPAT ; If there are no patients print informational message
+1 if GMRACNT
QUIT
+2 WRITE !,?24,"* No Patients for this ",$SELECT(GMRA="W":"Ward",GMRA="M":"Module",GMRA="C":"Clinic",1:"UNKNOWN")," *"
+3 WRITE !
+4 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,?23,"PATIENTS NOT ASKED ABOUT ALLERGIES",?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 !,?23,"FROM ",$$DATE^GMRAUTL1(GMRAST),?42,"TO ",$$DATE^GMRAUTL1(GMRAED)
+13 WRITE !!,"PATIENT",?30,"SSN"
if GMRA'="C"
WRITE ?45,"PROVIDER"
+14 WRITE !,$$REPEAT^XLFSTR("-",78)
+15 ; Check if stopped by user
IF $DATA(ZTQUEUED)
if $$STPCK^GMRAUTL1
SET GMRAOUT=1
+16 QUIT
PRE ; This will validate the TMP global and fire off Xref
+1 NEW GMRAX,GMRAY,GMRAT1,GMRAT2,GMRAT3
+2 if '$DATA(^TMP($JOB,"GMRAWC"))
QUIT
+3 SET GMRAX=0
FOR
SET GMRAX=$ORDER(^TMP($JOB,"GMRAWC",GMRAX))
if GMRAX<1
QUIT
Begin DoDot:1
+4 SET GMRAY=^TMP($JOB,"GMRAWC",GMRAX)
+5 SET GMRAT1=$PIECE($GET(^SC(GMRAX,0)),U,2)
+6 SET GMRAT2=$PIECE($GET(^SC(GMRAX,0)),U)
+7 SET GMRAT3=$SELECT(GMRAT1'="":GMRAT1,1:GMRAT2)
+8 SET ^TMP($JOB,"GMRAWC","C",GMRAT3,GMRAX)=""
+9 QUIT
End DoDot:1
+10 QUIT
EXIT ;
+1 KILL ^TMP($JOB,"GMRAWC")
+2 DO KILL^XUSCLEAN
+3 QUIT
