[613] | 1 | RMPR5HQ7 ;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
|
---|
| 8 | MAIL 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
|
---|
| 47 | MAILX Q
|
---|
| 48 | ;
|
---|
| 49 | ; Read HCPC level in ^TMP
|
---|
| 50 | RDHCPC(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
|
---|
| 61 | NXHCPC(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
|
---|
| 91 | NXHCPCX Q
|
---|
| 92 | MAP(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
|
---|