RMPRN6S ;HINES IOFO/HNC ;NPPD SORT LOGIC - 11/10/00
;;3.0;PROSTHETICS;**51,90**;Feb 09, 1996
;
;
DISP ;display info before dir call
W !
W !,?6,"Sort Options"
W !,?6,"------------"
W !,?6,"2 or 5 = USED INVENTORY ONLY (NEW REPORT)"
W !!,?6,"1 or 4 = NEW ITEM COSTS, USED INVENTORY (VA) COST AS ZERO,"
W !,?6," (PREVIOUS BRIEF/DETAILED NPPD REPORT)"
W !!,?6,"3 or 6 = NEW AND USED COST, BOTH DOLLAR AMOUNTS TOTALED (NEW REPORT)"
Q
SORTUSED ;sort only recovered items cost from PIP
;
S TYPE=$P(^RMPR(660,RD,0),U,4)
S TY=$S(TYPE="X":2,TYPE=5:2,TYPE="I":1,1:3)
S SOURCE=$P(^RMPR(660,RD,0),U,14)
;only va, or used, recovered items
Q:SOURCE'="V"
;stock issue null (not PIP) and source VA (used)
I $P(^RMPR(660,RD,1),U,5)="" Q
S CATEGRY=$P($G(^RMPR(660,RD,"AM")),U,3),SPEC=$P($G(^("AM")),U,4),GN=$P(^("AMS"),U,1)
S COST=$P(^RMPR(660,RD,0),U,16)
;form
;S FORM=$P(^RMPR(660,RD,0),U,13)
;I (FORM=4)!(FORM=15) S COST=0,SOURCE="V"
S QTY=$P(^RMPR(660,RD,0),U,7)
S B1=RD
S ^TMP($J,CODE,RD)=COST
I TY=2 D REP^RMPRN6
I TY'=2 D NEW^RMPRN6
Q
;
;
;
SORTBOTH ;sort both new and used recovered items cost
S TYPE=$P(^RMPR(660,RD,0),U,4)
S TY=$S(TYPE="X":2,TYPE=5:2,TYPE="I":1,1:3)
S SOURCE=$P(^RMPR(660,RD,0),U,14)
;
S CATEGRY=$P($G(^RMPR(660,RD,"AM")),U,3),SPEC=$P($G(^("AM")),U,4),GN=$P(^("AMS"),U,1)
S COST=$P(^RMPR(660,RD,0),U,16)
;stock issue source VA, used cost calculation is ACTUAL FOR BOTH
;I $P(^RMPR(660,RD,1),U,5)'=""&(SOURCE["V") S COST=0
;form
S FORM=$P(^RMPR(660,RD,0),U,13)
I (FORM=4)!(FORM=15) S COST=0,SOURCE="V"
S QTY=$P(^RMPR(660,RD,0),U,7)
S B1=RD
S ^TMP($J,CODE,RD)=COST
I TY=2 D REP^RMPRN6
I TY'=2 D NEW^RMPRN6
Q
HDR(X) ;display nppd sort header new or used
I X=2!(X=5) S X="USED INVENTORY ONLY"
I X=1!(X=4) S X="NEW ITEM COSTS, USED INVENTORY (VA) COST AS ZERO"
I X=3!(X=6) S X="NEW AND USED COST, BOTH DOLLAR AMOUNTS TOTALED"
Q X
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRN6S 1961 printed Nov 22, 2024@17:45:11 Page 2
RMPRN6S ;HINES IOFO/HNC ;NPPD SORT LOGIC - 11/10/00
+1 ;;3.0;PROSTHETICS;**51,90**;Feb 09, 1996
+2 ;
+3 ;
DISP ;display info before dir call
+1 WRITE !
+2 WRITE !,?6,"Sort Options"
+3 WRITE !,?6,"------------"
+4 WRITE !,?6,"2 or 5 = USED INVENTORY ONLY (NEW REPORT)"
+5 WRITE !!,?6,"1 or 4 = NEW ITEM COSTS, USED INVENTORY (VA) COST AS ZERO,"
+6 WRITE !,?6," (PREVIOUS BRIEF/DETAILED NPPD REPORT)"
+7 WRITE !!,?6,"3 or 6 = NEW AND USED COST, BOTH DOLLAR AMOUNTS TOTALED (NEW REPORT)"
+8 QUIT
SORTUSED ;sort only recovered items cost from PIP
+1 ;
+2 SET TYPE=$PIECE(^RMPR(660,RD,0),U,4)
+3 SET TY=$SELECT(TYPE="X":2,TYPE=5:2,TYPE="I":1,1:3)
+4 SET SOURCE=$PIECE(^RMPR(660,RD,0),U,14)
+5 ;only va, or used, recovered items
+6 if SOURCE'="V"
QUIT
+7 ;stock issue null (not PIP) and source VA (used)
+8 IF $PIECE(^RMPR(660,RD,1),U,5)=""
QUIT
+9 SET CATEGRY=$PIECE($GET(^RMPR(660,RD,"AM")),U,3)
SET SPEC=$PIECE($GET(^("AM")),U,4)
SET GN=$PIECE(^("AMS"),U,1)
+10 SET COST=$PIECE(^RMPR(660,RD,0),U,16)
+11 ;form
+12 ;S FORM=$P(^RMPR(660,RD,0),U,13)
+13 ;I (FORM=4)!(FORM=15) S COST=0,SOURCE="V"
+14 SET QTY=$PIECE(^RMPR(660,RD,0),U,7)
+15 SET B1=RD
+16 SET ^TMP($JOB,CODE,RD)=COST
+17 IF TY=2
DO REP^RMPRN6
+18 IF TY'=2
DO NEW^RMPRN6
+19 QUIT
+20 ;
+21 ;
+22 ;
SORTBOTH ;sort both new and used recovered items cost
+1 SET TYPE=$PIECE(^RMPR(660,RD,0),U,4)
+2 SET TY=$SELECT(TYPE="X":2,TYPE=5:2,TYPE="I":1,1:3)
+3 SET SOURCE=$PIECE(^RMPR(660,RD,0),U,14)
+4 ;
+5 SET CATEGRY=$PIECE($GET(^RMPR(660,RD,"AM")),U,3)
SET SPEC=$PIECE($GET(^("AM")),U,4)
SET GN=$PIECE(^("AMS"),U,1)
+6 SET COST=$PIECE(^RMPR(660,RD,0),U,16)
+7 ;stock issue source VA, used cost calculation is ACTUAL FOR BOTH
+8 ;I $P(^RMPR(660,RD,1),U,5)'=""&(SOURCE["V") S COST=0
+9 ;form
+10 SET FORM=$PIECE(^RMPR(660,RD,0),U,13)
+11 IF (FORM=4)!(FORM=15)
SET COST=0
SET SOURCE="V"
+12 SET QTY=$PIECE(^RMPR(660,RD,0),U,7)
+13 SET B1=RD
+14 SET ^TMP($JOB,CODE,RD)=COST
+15 IF TY=2
DO REP^RMPRN6
+16 IF TY'=2
DO NEW^RMPRN6
+17 QUIT
HDR(X) ;display nppd sort header new or used
+1 IF X=2!(X=5)
SET X="USED INVENTORY ONLY"
+2 IF X=1!(X=4)
SET X="NEW ITEM COSTS, USED INVENTORY (VA) COST AS ZERO"
+3 IF X=3!(X=6)
SET X="NEW AND USED COST, BOTH DOLLAR AMOUNTS TOTALED"
+4 QUIT X
END ;
