source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOLZA.m@ 971

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1RMPOLZA ;EDS/PAK - HOME OXYGEN LETTERS ;5/27/03 10:34
2 ;;3.0;PROSTHETICS;**29,77**;Feb 09, 1996
3 ;
4 ;RVD patch #77 - insure that dangling 'AC' x-ref will not cause
5 ; the undefined error.
6 ;
7QUIT() ;
8 ; Input: None
9 ; Output:
10 ; Quit flag - 1: time out on read
11 ; 0: no time out on read
12 ;
13 Q ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT))
14 ;
15SITE(RMPRSITE) ;find the site if the site is not multidivisional
16 ;
17 ; Input:
18 ; Prosthetics Site - valid site ID held in file 669.9
19 ; Output:
20 ; Site flag - 0: no H.O. site selected
21 ; 1: H.O. site selected
22 ;
23 ; Non interactive call to pull site parameters if site supplied
24 I RMPRSITE'="" D ^RMPRSIT M RMPO=RMPR S RMPOSITE=RMPO("STA") Q 1
25 ;
26 ; Interactive call requiring operator input
27 D HOSITE^RMPOUTL0 Q:$G(QUIT) 0 ; output RMPO("STA") - station number
28 W @IOF K ^TMP($J)
29 I '$G(RMPOREC) W !!,*7,"You must choose a Home Oxygen Site.",!! Q 0
30 S RMPOXITE=RMPOREC
31 Q 1
32 ;
33EXTRCT ; Extract patient demographics
34 ;
35 ; Input:
36 ; RMPODFN - Patient IEN to NEW PERSON file
37 ; ADT - Patient Rx activation date
38 ; Output:
39 ; ^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN) - LastName,FirstName^H.O. ActivateDate^
40 ; Rx Expiry Date^PrimaryItemName^Prescription^PrescriptionDate^TodaysDate^
41 ; ^Sex^AddressLine1^AddressLine2^AddressLine3^City^State^Zip
42 ;
43 ; quit if already generated demographic details for a patient
44 Q:$D(^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN))
45 ;
46 N INAME,DFN,VAPA,INFO
47 ;
48 S INAME="",DFN=RMPODFN
49 K VADM D DEM^VADPT,ADD^VADPT
50 ;
51 ; if patient has an active prescription get date entered & expiry date else set dates = NULL
52 I RMPORX'="",$D(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0)) S RMPOEXP=$P(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3),RMPORXDT=$P(^(0),U)
53 E S (RMPOEXP,RMPORXDT)=""
54 ;
55 ; get primary item
56 S INAME="",RMPOITEM=$O(^RMPR(665,"AC","Y",RMPODFN,0))
57 I RMPOITEM'="" D
58 . Q:'$D(^RMPR(665,RMPODFN,"RMPOC",RMPOITEM,0))
59 . S RMPOITEM=$P(^RMPR(665,RMPODFN,"RMPOC",RMPOITEM,0),U),RMPOITEM=$P(^RMPR(661,RMPOITEM,0),U)
60 . S INAME=$P(^PRC(441,RMPOITEM,0),U,2)
61 ;
62 ;set the ^TMP($J,RMPOXITE,"RMPODEMO" global with patient demographics
63 S INFO=VADM(1)_U_$P(VADM(2),U,2)_U_ADT_U_RMPOEXP_U_INAME
64 S INFO=INFO_U_RMPORX_U_RMPORXDT_U_DT_U_$P(VADM(5),U)_U_VAPA(1)_U_VAPA(2)_U_VAPA(3)_U_VAPA(4)_U_$P(VAPA(5),U,2)_U_VAPA(6)
65 S ^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN)=INFO Q:'$D(RMPOLCD)!RMPOLCD=""
66 Q
67 ;
68LOCK() ; lock virtual list record
69 ;
70 ; Input:
71 ; JOB - 1: job, 2: interactive
72 ;
73 ; Output:
74 ; None
75 ;
76 L +^TMP("RMPO",$J,RMPOXITE,"LETTERPRINT"):0
77 I '$T W:'JOB !,"Cannot continue as list edit or printing is in progress" H 2 Q 0
78 Q 1
79 ;
80UPDLTR(DA,VAL) ; Update 'Letter to be sent' in Prosthetics Patient File
81 ;
82 ; I/P :
83 ; VAL - value to be inserted into field
84 ;
85 N DIE
86 ;
87 S DR="19.13///"_VAL,DIE="^RMPR(665," D ^DIE
88 Q
89 ;
90SELN(TYP,TXT,MAX) ;
91 ;
92 ; Input:
93 ; TYP(e) - section type: "L"ist of #
94 ; single "N"umber
95 ; TeXT - prompt text
96 ; MAX - maximum valid number
97 ;
98 ; Output:
99 ; Y - selected number or range of numbers
100 ;
101 N DIR,Y
102 ;
103 D FULL^VALM1
104 S DIR("A")=TXT,DIR(0)=TYP_"^1:"_MAX_":0"
105 D ^DIR
106 Q:$$QUIT^RMPOLZA 0
107 I Y="" S VALMBCK="R",Y=0
108 Q Y
Note: See TracBrowser for help on using the repository browser.