GMRAPNA.m

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 ---GMRAPNA   3571     printed  Mar 13, 2025@20:44:54                                                                                                                                                                                                     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