- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL1.m
r613 r623 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 1 GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ; 12/04/92 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 Q 4 STPCK() ; 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 10 BR ; 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 20 PR ; 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 29 PR1 ; 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 34 LP1 ; 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 45 VAD(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 68 DATE(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 TracChangeset
for help on using the changeset viewer.
