[628] | 1 | GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ;12/04/92
|
---|
| 2 | ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to $$PROD^XUPROD supported by DBIA 4440
|
---|
| 5 | ; Reference to $$TESTPAT^VADPT supported by DBIA 3744
|
---|
| 6 | ;
|
---|
| 7 | Q
|
---|
| 8 | STPCK() ; This is to check to see if the user wanted to stop the print
|
---|
| 9 | S ZTSTOP=0
|
---|
| 10 | I $$S^%ZTLOAD D
|
---|
| 11 | .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
|
---|
| 12 | .Q
|
---|
| 13 | Q ZTSTOP
|
---|
| 14 | BR ; This is a online reference card entry point
|
---|
| 15 | I '$$TEST^DDBRT D Q
|
---|
| 16 | .W $C(7)
|
---|
| 17 | .W !,?20,"Your Terminal cannot display this Reference Card."
|
---|
| 18 | .W !,?20,"Please contact IRM Service to correct this problem."
|
---|
| 19 | .Q
|
---|
| 20 | N X
|
---|
| 21 | S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1
|
---|
| 22 | D WP^DDBR(120.87,X,1)
|
---|
| 23 | Q
|
---|
| 24 | PR ; This is a print utility for the reference card for IRM
|
---|
| 25 | W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
|
---|
| 26 | I $D(IO("Q")) D Q
|
---|
| 27 | . S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
|
---|
| 28 | . S ZTDESC="Print reference card" D ^%ZTLOAD
|
---|
| 29 | . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
|
---|
| 30 | . Q
|
---|
| 31 | U IO D PR1 U IO(0)
|
---|
| 32 | Q
|
---|
| 33 | PR1 ; Print out the card
|
---|
| 34 | N GMRAOUT,GMRACD,GMRALN,X
|
---|
| 35 | I $E(IOST,1)="C" W @IOF
|
---|
| 36 | S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0))
|
---|
| 37 | S (GMRAOUT,GMRALN)=0
|
---|
| 38 | LP1 ; Main loop
|
---|
| 39 | F S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1 D Q:GMRAOUT
|
---|
| 40 | .S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0))
|
---|
| 41 | .W !,X
|
---|
| 42 | .I $Y>(IOSL-4) D
|
---|
| 43 | ..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
|
---|
| 44 | ..W @IOF
|
---|
| 45 | ..Q
|
---|
| 46 | .Q
|
---|
| 47 | D CLOSE^GMRAUTL
|
---|
| 48 | Q
|
---|
| 49 | PRDTST(GMRADFN) ; GMRA*4*33 - Remove Test Patients from Live Reports
|
---|
| 50 | ; This function will return 0 if the patient should not print on the report, and 1 if the patient
|
---|
| 51 | ; should appear on the report. This function will allow all patients to print on the report if the
|
---|
| 52 | ; report is run in a test environment.
|
---|
| 53 | ;
|
---|
| 54 | I GMRADFN="" Q 0 ;DFN not defined. Should never be the case.
|
---|
| 55 | I '$$PROD^XUPROD() Q 1 ;Not a production or legacy environment. Print all patients on report.
|
---|
| 56 | I $$TESTPAT^VADPT(GMRADFN) Q 0 ;Production or legacy environment. Test patient. Do not print on report.
|
---|
| 57 | Q 1 ;Production or legacy environment. Not a test patient. Print on report.
|
---|
| 58 | ;
|
---|
| 59 | VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT
|
---|
| 60 | ; This call is a generic call to 1^VADPT
|
---|
| 61 | ; Input:
|
---|
| 62 | ; 1 DFN = Patient Internal entry number in the Patient File
|
---|
| 63 | ; 2 DAT = Date for lookup
|
---|
| 64 | ;
|
---|
| 65 | ; Output:
|
---|
| 66 | ; 3 LOC = Hospital Location
|
---|
| 67 | ; 4 NAM = Full Patient name
|
---|
| 68 | ; 5 SEX = Patient SEX
|
---|
| 69 | ; 6 SSN = Patient SSN
|
---|
| 70 | ; 7 RB = Patient Room Bed
|
---|
| 71 | ; 8 PRO = Patient Provider
|
---|
| 72 | ; 9 PID = Patient ID
|
---|
| 73 | ;
|
---|
| 74 | S DFN=$G(DFN) Q:DFN=""
|
---|
| 75 | S VAINDT=$G(DAT) I VAINDT="" K VAINDT
|
---|
| 76 | D 1^VADPT
|
---|
| 77 | S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5)
|
---|
| 78 | S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID")
|
---|
| 79 | S PRO=$P(VAIN(2),U,2)
|
---|
| 80 | D KVAR^VADPT K VA,VAROOT
|
---|
| 81 | Q
|
---|
| 82 | DATE(DATE) ; This Ex-Function will date the date from the DATE
|
---|
| 83 | ; and convert it to the old DD("DD") style format
|
---|
| 84 | ; it returns the answer in DATE
|
---|
| 85 | N Y
|
---|
| 86 | S Y=$$FMTE^XLFDT(DATE,1)
|
---|
| 87 | S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3)
|
---|
| 88 | Q DATE
|
---|