| 1 | RMPR37A ;PHX/JLT-CONTINUATION OF POST 2237 TO 10-2319 RMPR37 ;8/29/1994
|
|---|
| 2 | ;;3.0;PROSTHETICS;;Feb 09, 1996
|
|---|
| 3 | A ;DISPLAY ITEMS INFORMATION ON 2237
|
|---|
| 4 | Q:'$D(R410("IT")) W !?5,ITN,">"
|
|---|
| 5 | S D1=0 F I=0:0 S D1=$O(R410("IT",ITN,1,D1)) Q:D1'>0 W ?10,$P(R410("IT",ITN,1,D1,0),U,1),!
|
|---|
| 6 | D A1
|
|---|
| 7 | K R1,RZZZ,QT,CT Q
|
|---|
| 8 | A1 S RTN=R410("IT",ITN,0)
|
|---|
| 9 | W ?10,"QTY: ",$P(RTN,U,2),?20,"UNIT OF ISSUE: "
|
|---|
| 10 | S UN=$P(RTN,U,3)
|
|---|
| 11 | W:+UN $P(^PRCD(420.5,UN,0),U,1)
|
|---|
| 12 | W ?40,"UNIT COST:"
|
|---|
| 13 | S (X,CT)=$P(RTN,U,7),X2="2$" D COMMA^%DTC
|
|---|
| 14 | W X,!
|
|---|
| 15 | S QT=$P(RTN,U,2),CTT=CTT+(CT*QT)
|
|---|
| 16 | Q
|
|---|
| 17 | NUM ;CHECK FOR ITEMS BY NUMBER ENTRY
|
|---|
| 18 | I $D(^RMPR(661,"B",RMPRY)) S X=RMPRY,DIC(0)="NMZ",DIC=441 D ^DIC I +Y S RIT(RMPRY,$P(Y(0),U,2))=""
|
|---|
| 19 | I '$D(R410("IT",RMPRY,1))&($D(RIT)) Q
|
|---|
| 20 | I '$D(R410("IT",RMPRY,1)) W $C(7),"??" Q
|
|---|
| 21 | F RI=0:0 S RI=$O(R410("IT",RMPRY,1,RI)) Q:RI'>0 S RZ=R410("IT",RMPRY,1,RI,0) I RZ'="" D EXT
|
|---|
| 22 | Q
|
|---|
| 23 | EXT S (CI,C1)=1,GI=$L(RZ,",")
|
|---|
| 24 | I GI>0 F I=1:1:GI-1 S RAT=$F(RZ,",") S RZ=$E(RZ,1,RAT-2)_" "_$E(RZ,RAT,99)
|
|---|
| 25 | F RT=1:1 S RE=$E(RZ,RT) Q:$A(RE)'>0 I $A(RE)=32 S CI=CI+1
|
|---|
| 26 | F RT=1:1:CI S RD=$P(RZ," ",RT) S:$L(RD)>2 RD(RD)=RD
|
|---|
| 27 | D PAR Q
|
|---|
| 28 | CHK ;CHECK FOR ITEMS IN 661 BY SHORT DESCRIPTION X-REF
|
|---|
| 29 | S AZL=$L(RMPRY)
|
|---|
| 30 | I $D(^PRC(441,"C",RZ)) F RG=0:0 S RG=$O(^PRC(441,"C",RZ,RG)) Q:RG'>0 S:$D(^RMPR(661,"B",RG)) RIT(RG,RZ)="" G:'$D(^RMPR(661,"B",RG)) EXT
|
|---|
| 31 | S RD(RZ)="" G EXT
|
|---|
| 32 | PAR S RXX="" F RF=0:0 S RXX=$O(RD(RXX)) Q:RXX="" I $D(^PRC(441,"C",RXX)) F RNI=0:0 S RNI=$O(^PRC(441,"C",RXX,RNI)) Q:RNI'>0 I $D(^RMPR(661,"B",RNI)) S RIT(RNI,RXX)=""
|
|---|
| 33 | S RB="" F RF=0:0 S RB=$O(RD(RB)) Q:RB="" S:RMPRY AZL=3 S RJ=$E(RB,1,AZL) F KK=0:0 S RJ=$O(^PRC(441,"C",RJ)) Q:$E(RB,1,AZL)'=$E(RJ,1,AZL) F RIN=0:0 S RIN=$O(^PRC(441,"C",RJ,RIN)) Q:RIN'>0 I $D(^RMPR(661,"B",RIN)) S RIT(RIN,RJ)=""
|
|---|
| 34 | Q
|
|---|
