Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAUTL1

GMRAUTL1.m

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