source: FOIAVistA/tag/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPNA.m@ 636

GMRAPNA ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;12/1/95  14:15
 ;;4.0;Adverse Reaction Tracking;**30**;Mar 29, 1996
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 queueing
 ;***** 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.
 ..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