source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL1.m@ 1166

GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ;12/04/92
 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
 ;
 ; Reference to $$PROD^XUPROD supported by DBIA 4440
 ; Reference to $$TESTPAT^VADPT supported by DBIA 3744
 ; 
 Q
STPCK() ; This is to check to see if the user wanted to stop the print
 S ZTSTOP=0
 I $$S^%ZTLOAD D
 .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
 .Q
 Q ZTSTOP
BR ; This is a online reference card entry point
 I '$$TEST^DDBRT D  Q
 .W $C(7)
 .W !,?20,"Your Terminal cannot display this Reference Card."
 .W !,?20,"Please contact IRM Service to correct this problem."
 .Q
 N X
 S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1
 D WP^DDBR(120.87,X,1)
 Q
PR ; This is a print utility for the reference card for IRM
 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
 I $D(IO("Q")) D  Q
 . S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
 . S ZTDESC="Print reference card" D ^%ZTLOAD
 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
 . Q
 U IO D PR1 U IO(0)
 Q
PR1 ; Print out the card
 N GMRAOUT,GMRACD,GMRALN,X
 I $E(IOST,1)="C" W @IOF
 S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0))
 S (GMRAOUT,GMRALN)=0
LP1 ; Main loop
 F  S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1  D  Q:GMRAOUT
 .S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0))
 .W !,X
 .I $Y>(IOSL-4) D
 ..I $E(IOST,1)="C" N DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E" D ^DIR S:$D(DIRUT) GMRAOUT=1 W:'GMRAOUT @IOF Q
 ..W @IOF
 ..Q
 .Q
 D CLOSE^GMRAUTL
 Q
PRDTST(GMRADFN) ; GMRA*4*33 - Remove Test Patients from Live Reports
 ; This function will return 0 if the patient should not print on the report, and 1 if the patient
 ; should appear on the report.  This function will allow all patients to print on the report if the
 ; report is run in a test environment.
 ;
 I GMRADFN="" Q 0  ;DFN not defined. Should never be the case.
 I '$$PROD^XUPROD() Q 1  ;Not a production or legacy environment.  Print all patients on report.
 I $$TESTPAT^VADPT(GMRADFN) Q 0  ;Production or legacy environment.  Test patient.  Do not print on report.
 Q 1  ;Production or legacy environment.  Not a test patient.  Print on report.
 ; 
VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT
 ; This call is a generic call to 1^VADPT
 ; Input:
 ; 1     DFN = Patient Internal entry number in the Patient File
 ; 2     DAT = Date for lookup
 ;
 ; Output:
 ; 3     LOC = Hospital Location
 ; 4     NAM = Full Patient name
 ; 5     SEX = Patient SEX
 ; 6     SSN = Patient SSN
 ; 7     RB  = Patient Room Bed
 ; 8     PRO = Patient Provider
 ; 9     PID = Patient ID
 ;
 S DFN=$G(DFN) Q:DFN=""
 S VAINDT=$G(DAT) I VAINDT="" K VAINDT
 D 1^VADPT
 S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5)
 S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID")
 S PRO=$P(VAIN(2),U,2)
 D KVAR^VADPT K VA,VAROOT
 Q
DATE(DATE) ; This Ex-Function will date the date from the DATE
 ; and convert it to the old DD("DD") style format
 ; it returns the answer in DATE
 N Y
 S Y=$$FMTE^XLFDT(DATE,1)
 S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3)
 Q DATE