source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL1.m@ 699

Last change on this file since 699 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.3 KB
Line 
1GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ; 12/04/92
2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
3 Q
4STPCK() ; This is to check to see if the user wanted to stop the print
5 S ZTSTOP=0
6 I $$S^%ZTLOAD D
7 .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
8 .Q
9 Q ZTSTOP
10BR ; This is a online reference card entry point
11 I '$$TEST^DDBRT D Q
12 .W $C(7)
13 .W !,?20,"Your Terminal cannot display this Reference Card."
14 .W !,?20,"Please contact IRM Service to correct this problem."
15 .Q
16 N X
17 S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1
18 D WP^DDBR(120.87,X,1)
19 Q
20PR ; This is a print utility for the reference card for IRM
21 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
22 I $D(IO("Q")) D Q
23 . S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
24 . S ZTDESC="Print reference card" D ^%ZTLOAD
25 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
26 . Q
27 U IO D PR1 U IO(0)
28 Q
29PR1 ; Print out the card
30 N GMRAOUT,GMRACD,GMRALN,X
31 I $E(IOST,1)="C" W @IOF
32 S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0))
33 S (GMRAOUT,GMRALN)=0
34LP1 ; Main loop
35 F S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1 D Q:GMRAOUT
36 .S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0))
37 .W !,X
38 .I $Y>(IOSL-4) D
39 ..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
40 ..W @IOF
41 ..Q
42 .Q
43 D CLOSE^GMRAUTL
44 Q
45VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT
46 ; This call is a generic call to 1^VADPT
47 ; Input:
48 ; 1 DFN = Patient Internal entry number in the Patient File
49 ; 2 DAT = Date for lookup
50 ;
51 ; Output:
52 ; 3 LOC = Hospital Location
53 ; 4 NAM = Full Patient name
54 ; 5 SEX = Patient SEX
55 ; 6 SSN = Patient SSN
56 ; 7 RB = Patient Room Bed
57 ; 8 PRO = Patient Provider
58 ; 9 PID = Patient ID
59 ;
60 S DFN=$G(DFN) Q:DFN=""
61 S VAINDT=$G(DAT) I VAINDT="" K VAINDT
62 D 1^VADPT
63 S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5)
64 S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID")
65 S PRO=$P(VAIN(2),U,2)
66 D KVAR^VADPT K VA,VAROOT
67 Q
68DATE(DATE) ; This Ex-Function will date the date from the DATE
69 ; and convert it to the old DD("DD") style format
70 ; it returns the answer in DATE
71 N Y
72 S Y=$$FMTE^XLFDT(DATE,1)
73 S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3)
74 Q DATE
Note: See TracBrowser for help on using the repository browser.