source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQ7.m@ 794

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1RMPR5HQ7 ;HCIOFO/ODJ - INVENTORY ROLL UP - CREATE ^TMP GLOBAL FOR MAILING ; 20 SEP 00
2 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
3 Q
4 ;
5 ; Required vars are
6 ; RMPRSDT
7 ; RMPREDT
8MAIL N KEYS,EOF,LINE,STR,TSTR,GROUP,CHNG,TNAM,USTR
9 S TNAM="RMPR5A"
10 K ^TMP($J,TNAM)
11 D GRPARY^RMPR5HQ4(.GROUP)
12 D INIT^RMPR5HQ6(.KEYS,.EOF,.CHNG)
13 I EOF G MAILX
14 S TSTR=""
15 S $P(TSTR,"^",3)=$E(RMPRSDT,4,5)_"/"_$E(RMPRSDT,6,7)_"/"_(1700+$E(RMPRSDT,1,3))
16 S $P(TSTR,"^",4)=$E(RMPREDT,4,5)_"/"_$E(RMPREDT,6,7)_"/"_(1700+$E(RMPREDT,1,3))
17 S LINE=0
18 F D Q:EOF
19 . I CHNG("STATION") D
20 .. S $P(TSTR,"^",2)=$P($G(^DIC(4,KEYS("STATION"),0)),"^",1)
21 .. S I=$O(^RMPR(669.9,"C",KEYS("STATION"),"")) Q:I=""
22 .. S $P(TSTR,"^",1)=$P($G(^RMPR(669.9,I,"INV")),"^",2) ;VISN
23 .. Q
24 . I CHNG("NPPD_GROUP") S $P(TSTR,"^",5)=GROUP(KEYS("NPPD_GROUP"))
25 . I CHNG("NPPD_LINE") S $P(TSTR,"^",6)=KEYS("NPPD_LINE")_" "_$$NPLIN^RMPR5HQ5(KEYS("NPPD_LINE"))
26 . ;I CHNG("HCPC_CODE") S $P(TSTR,"^",7)=$$GETITEM^RMPR5HQ5(KEYS("HCPC_IEN"),"")
27 . I CHNG("HCPC_CODE") S $P(TSTR,"^",7)=KEYS("HCPC_CODE")
28 . D RDHCPC(.KEYS,.STR) S:'+$P(STR,"^",3) $P(STR,"^",3)=""
29 . I $L(STR,"^")<13 S $P(STR,"^",13)=""
30 . F I=6,12 S:+$P(STR,"^",I) $P(STR,"^",I)=$J($P(STR,"^",I),0,2)
31 . F I=7,13 S:+$P(STR,"^",I) $P(STR,"^",I)=$J($P(STR,"^",I),0,1)
32 . I (+$P(STR,"^",1)&+$P(STR,"^",2))!(+$P(STR,"^",8)&+$P(STR,"^",9)) D
33 .. S USTR=STR
34 .. F I=2,5,6,7,9,11 S $P(USTR,"^",I)=""
35 .. F I=1,4,8,10,12,13 S $P(STR,"^",I)=""
36 .. S LINE=LINE+1
37 .. D MAP(USTR,.TSTR)
38 .. S ^TMP($J,TNAM,LINE)=TSTR
39 .. S TSTR=$P(TSTR,"^",1,7)
40 .. Q
41 . S LINE=LINE+1
42 . D MAP(STR,.TSTR)
43 . S ^TMP($J,TNAM,LINE)=TSTR
44 . S TSTR=$P(TSTR,"^",1,7)
45 . D NXHCPC(.KEYS,.EOF,.CHNG)
46 . Q
47MAILX Q
48 ;
49 ; Read HCPC level in ^TMP
50RDHCPC(PRIKEY,MYSTR) ;
51 N TNAM,STATION,NPGRP,NPLIN,HCPC
52 S TNAM="RMPR5"
53 S STATION=PRIKEY("STATION")
54 S NPGRP=PRIKEY("NPPD_GROUP")
55 S NPLIN=PRIKEY("NPPD_LINE")
56 S HCPC=PRIKEY("HCPC")
57 S MYSTR=$G(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC))
58 Q
59 ;
60 ; Get next HCPC code
61NXHCPC(RMPRKEY,RMPREOF,RMPRCHNG) ;
62 N TNAM,NPGRP,NPLIN,HCPC,ITEM,INVIEN,STATION
63 S TNAM="RMPR5"
64 S STATION=RMPRKEY("STATION")
65 S NPGRP=RMPRKEY("NPPD_GROUP")
66 S NPLIN=RMPRKEY("NPPD_LINE")
67 S HCPC=RMPRKEY("HCPC")
68 S RMPRCHNG("STATION")=0
69 S RMPREOF=0,RMPRCHNG("NPPD_GROUP")=0,RMPRCHNG("NPPD_LINE")=0
70 S HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC))
71 S:HCPC="" NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN))
72 S:NPLIN="" NPGRP=$O(^TMP($J,TNAM,STATION,NPGRP))
73 S:NPGRP="" STATION=$O(^TMP($J,TNAM,STATION))
74 I STATION=""!(STATION="Z") S RMPREOF=1,RMPRCHNG("HCPC_CODE")=0,RMPRCHNG("HCPC_ITEM")=0,RMPRCHNG("INVENTORY_IEN")=0 G NXHCPCX
75 S:NPGRP="" NPGRP=$O(^TMP($J,TNAM,STATION,"")),RMPRCHNG("STATION")=1
76 S:NPLIN="" NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,"")),RMPRCHNG("NPPD_GROUP")=1
77 S:HCPC="" HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,"")),RMPRCHNG("NPPD_LINE")=1
78 S RMPRCHNG("HCPC_CODE")=1
79 S ITEM=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,""))
80 S RMPRCHNG("HCPC_ITEM")=1
81 S INVIEN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,""))
82 S RMPRCHNG("INVENTORY_IEN")=1
83 S RMPRKEY("STATION")=STATION
84 S RMPRKEY("NPPD_GROUP")=NPGRP
85 S RMPRKEY("NPPD_LINE")=NPLIN
86 S RMPRKEY("HCPC")=HCPC
87 S RMPRKEY("HCPC_CODE")=$P(HCPC,"/",1)
88 S RMPRKEY("HCPC_IEN")=$P(HCPC,"/",2)
89 S RMPRKEY("HCPC_ITEM")=ITEM
90 S RMPRKEY("INVENTORY_IEN")=INVIEN
91NXHCPCX Q
92MAP(CALC,RUP) ;
93 S $P(RUP,"^",8)=$P(CALC,"^",2)
94 S $P(RUP,"^",9)=$P(CALC,"^",5)
95 S:+$P(RUP,"^",8) $P(RUP,"^",10)=$J($P(RUP,"^",9)/$P(RUP,"^",8),0,2)
96 S $P(RUP,"^",11)=$P(CALC,"^",6)
97 S $P(RUP,"^",12)=$P(CALC,"^",7)
98 S $P(RUP,"^",13)=$P(CALC,"^",9)
99 S $P(RUP,"^",14)=$P(CALC,"^",11)
100 S:+$P(RUP,"^",13) $P(RUP,"^",15)=$J($P(RUP,"^",14)/$P(RUP,"^",13),0,2)
101 S $P(RUP,"^",16)=$P(CALC,"^",1)
102 S $P(RUP,"^",17)=$P(CALC,"^",4)
103 S:+$P(RUP,"^",16) $P(RUP,"^",18)=$J($P(RUP,"^",17)/$P(RUP,"^",16),0,2)
104 S $P(RUP,"^",19)=$P(CALC,"^",12)
105 S $P(RUP,"^",20)=$P(CALC,"^",13)
106 S $P(RUP,"^",21)=$P(CALC,"^",8)
107 S $P(RUP,"^",22)=$P(CALC,"^",10)
108 S:+$P(RUP,"^",21) $P(RUP,"^",23)=$J($P(RUP,"^",22)/$P(RUP,"^",21),0,2)
109 S $P(RUP,"^",24)=$G(RMCALDAY)
110 Q
Note: See TracBrowser for help on using the repository browser.