75 lines
2.3 KiB
Mathematica
75 lines
2.3 KiB
Mathematica
GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ; 12/04/92
|
|
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
|
|
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
|
|
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
|