source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOLY.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1RMPOLY ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
2 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
3 ;
4EN ; -- main entry point for RMPO LETTER TYPE
5 ;
6 ; Input: None
7 ;
8 ; Output:
9 ; RMPOLCD - H.O. Letter Type code
10 ;
11 ; Called by:
12 ; RMPOLZ - H.O. Letter Control module
13 ;
14 N LSTN
15 ;
16 D EN^VALM("RMPO LETTER TYPE")
17 Q
18 ;
19HDR ; -- header code
20 ;
21 S VALMHDR(1)=$$CNTR(" ",RMPO("NAME"),80)
22 S VALMHDR(2)=$$CNTR(" ","HOME OXYGEN PATIENT LETTER TYPE LIST",80)
23 Q
24 ;
25INIT ; -- init variables and list array
26 N SP,RMPOLCD,CNT,X,RMPOLTR,LTR
27 ;
28 S $P(SP," ",80)=" "
29 ;
30 ; initialise list
31 S (PATV,VALMCNT,RMPOLCD,CNT)=0
32 ; for each valid H.O. letter type code define a line
33 F S RMPOLCD=$O(LTRX("A",RMPOLCD)) Q:RMPOLCD="" D
34 . S VALMCNT=VALMCNT+1,LSTN(VALMCNT)=RMPOLCD
35 . S CNT=0,RMPONAM=""
36 . F S RMPONAM=$O(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM="" D
37 . . S CNT=CNT+1
38 . . S RMPOLTR=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1),RMPODFN=$P(^(RMPONAM),U,2)
39 . . S LTR=$P(^RMPR(665.2,RMPOLTR,0),U)
40 . . D UPDLTR^RMPOLET0(RMPODFN,LTR) ; update "letter to be sent" flag for patient
41 . ;
42 . S X=$$SETFLD^VALM1($E(VALMCNT_SP,1,$P(VALMDDF("LINE #"),U,3)),"","LINE #")
43 . S X=$$SETFLD^VALM1($$EXTERNAL^DILFD(669.965,1,"",RMPOLCD),X,"DESCRIPTION")
44 . S X=$$SETFLD^VALM1(CNT,X,"PATIENT COUNT")
45 . D SET^VALM10(VALMCNT,X,CNT) ; create list line
46 . S:CNT PATV=1 ; at least one line have a patient count value > 0
47 ;
48 Q
49 ;
50HELP ; -- help code
51 S X="?" D DISP^XQORM1 W !!
52 Q
53 ;
54EXIT ; -- exit code
55 D CLEAN^VALM10
56 K LSTN,PATV
57 ;
58 Q
59 ;
60EXPND ; -- expand code
61 Q
62 ;
63EN01 ; Select letter type
64 N Y
65 S VALMBCK="R",LST=0
66 ;I 'PATV S VALMSG="There are no patients awaiting a letter" Q
67 S Y=$$SELN^RMPOLZA("N","Select letter type line #",VALMCNT) Q:'Y
68 I $G(^TMP($J,RMPOXITE,"EXIT"))=1 S QT=1 Q
69 S VALMBCK="Q"
70 S (RMPOLCD,RMC)=LSTN(Y)
71 S RMBAT=$S(RMC="A":"RMPOXBAT1",RMC="B":"RMPOXBAT2",RMC="C":"RMPOXBAT3",1:"")
72 S RMBATCO=$S(RMC="A":"^669.9002P^^",RMC="B":"^669.972P^^",RMC="C":"^669.974P^^^",1:"")
73 ;K ^RMPR(669.9,RMPOXITE,RMBAT) S ^RMPR(669.9,RMPOXITE,RMBAT,0)=RMBATCO
74 D NEWLST^RMPOLZ
75 I $O(^RMPR(669.9,RMPOXITE,RMBAT,0))'>0 S VALMSG="No patients are awaiting letters of this type!!" H 4 W !,VALMSG Q
76 W !,"DONE GENERATING A NEW LIST..." H 4
77 ; rebuild letter type list.
78 D CLEAN^VALM10,INIT^RMPOLY S VALMBCK="R",RMPOLCD=""
79 Q
80 ;
81EN02 ; Print letters
82 ; select letter type. Quit if none choosen
83 ;D EN01^RMPOLY S VALMBCK="R" Q:RMPOLCD=""
84 N Y
85 S VALMBCK="R"
86 I 'PATV S VALMSG="There are no patients awaiting a letter" Q
87 ;
88 S Y=$$SELN^RMPOLZA("N","Select letter type line #",VALMCNT) Q:'Y
89 W !,$C(7),"Processing...."
90 I '$O(@VALMAR@("IDX",Y,"")) S VALMSG="No patients are awaiting letters of this type!!" H 4 W !,VALMSG Q
91 S VALMBCK="Q",RMPOLCD=LSTN(Y)
92 ;ask for patient to print
93 D EN^RMPOLT
94 ; rebuild letter type list.
95 D CLEAN^VALM10,INIT^RMPOLY S VALMBCK="R",RMPOLCD=""
96 Q
97 ;
98CNTR(PD,TXT,WDT) ; Centre text
99 S $P(PD,PD,WDT)=PD
100 Q $E(PD,1,(WDT-$L(TXT))/2)_TXT
Note: See TracBrowser for help on using the repository browser.