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

Last change on this file since 1096 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1GMRAUTL1 ;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
8STPCK() ; 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
14BR ; 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
24PR ; 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
33PR1 ; 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
38LP1 ; 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
49PRDTST(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 ;
59VAD(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
82DATE(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
Note: See TracBrowser for help on using the repository browser.