- RMPFDT2 ;DDC/KAW-DISPLAY MODELS; [ 03/12/98 7:46 AM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**10**;JUN 16, 1995
- ;;input: RMPFX,RMPFHAT,RMPFTYP
- ;;output: RMPFMD,CX,RMPFO
- I $D(RMPFX),RMPFX
- E Q
- I '$O(^RMPF(791810,RMPFX,101,0)) D HEAD G END
- D ARRAY
- S (RMPFY,CX,RMPFTOT)=0 K RMPFMD
- D1 S RMPFY=$O(RMPFO(RMPFY)) G TOT:RMPFY="" D SHOW G D1
- SHOW Q:'$D(^RMPF(791810,RMPFX,101,RMPFY,0)) S S1=^(0),S4=$G(^(3)),RMPFIT=$P(S1,U,1),CT=0
- Q:'RMPFIT Q:'$D(^RMPF(791811,RMPFIT,0)) S S2=^(0)
- S RMPFTT=$P(S4,U,1),RMPFDIS=$P(S4,U,2)
- I $L(RMPFDIS) S RMPFDIS=$P($G(^RMPR(662,RMPFDIS,0)),U,1)
- S RMPFDSN=$P(S4,U,3),X=$P(S4,U,4),(RMPFPCT,RMPFPSC)=""
- I X S RMPFPCT=$S(X=1:"SC/OP",X=2:"SC/IP",X=3:"NSC/IP",X=4:"NSC/OP",1:"")
- S X=$P(S4,U,5) I X S RMPFPSC=$S(X=1:"Spec",X=2:"A&A",X=3:"PHC",1:"")
- S CX=CX+1 K RMPFN,RMPFC
- S RMPFITP=$P(S2,U,1),RMPFMAK=$P(S2,U,2)
- S RMPFCOST=$J($P(S1,U,14),0,2),RMPFLR=$P(S1,U,4)
- S RMPFRACT=$P(S1,U,9),RMPFRACT=$S(RMPFRACT="D":"DEFECTIVE",RMPFRACT="R":"REDUCE STOCK",1:"")
- S RMPFACQD="",Y=$P(S1,U,3) I Y S RMPFACQD=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
- S X=$P(S1,U,8),RMPFISDP="" I X S RMPFISDP=$E(X,4,5)_"-"_$E(X,6,7)_"-"_($E(X,1,3)+1700)
- S RMPFSN=$P(S1,U,5),RMPFBAT=$P(S1,U,2),RMPFLIS=$P(S1,U,18)
- I RMPFLIS,$D(^RMPF(791810.2,RMPFLIS,0)) S RMPFLIS=$P(^(0),U,4)
- S RMPFTOI=$P(S1,U,7),RMPFTOI=$S(RMPFTOI="T":"TEMPORARY",RMPFTOI="P":"PERMANENT",1:""),(RMPFQTY,QT)=$P(S1,U,6) S:'QT QT=1
- S RMPFRED="",Y=$P(S1,U,13) I Y?7N S RMPFRED=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
- S RMPFOB=$P(S1,U,11),RMPFTOL=$P(S1,U,10)
- S RMPFISRE=$P(S1,U,12),RMPFISRE=$S(RMPFISRE="P":"PERMANENT ISSUE",RMPFISRE="R":"RECOVERY",RMPFISRE="T":"TEMPORARY ISSUE",RMPFISRE="S":"STATION LOANER",1:"")
- S S3=$G(^RMPF(791810,RMPFX,101,RMPFY,2))
- I RMPFIT=1 S RMPFMAK=$P(S3,U,1),RMPFITP=$P(S3,U,2)
- I RMPFBAT,$D(^RMPF(791811.3,RMPFBAT,0)) S RMPFBAT=$P(^(0),U,1)
- S RMPFBAT2=$P(S3,U,3) I RMPFBAT2,$D(^RMPF(791811.3,RMPFBAT2,0)) S RMPFBAT2=$P(^(0),U,1)
- S RMPFPG=$P(S3,U,4) I RMPFPG,$D(^RMPF(791811.1,RMPFPG,0)) S RMPFPG=$P(^(0),U,1)
- S RMPFMD(CX)=RMPFY
- S X=0 F I=1:1 S X=$O(^RMPF(791810,RMPFX,101,RMPFY,101,X)) Q:'X I $D(^(X,0)),$P(^(0),U)'="" S RMPFN(I)=$P(^(0),U,1)
- S S9=$G(^RMPF(791810,RMPFX,101,RMPFY,90)),RMPFRDC=$P(S9,U,6)
- I RMPFRDC S RMPFRDC=$E(RMPFRDC,4,5)_"-"_$E(RMPFRDC,6,7)_"-"_($E(RMPFRDC,1,3)+1700)
- S RMPFCUR=$P(S9,U,5),RMPFCERU=$P(S9,U,8),RMPFCERD=$P(S9,U,9)
- I $P(S9,U,10) S RMPFCERU=$P(S9,U,10),RMPFCERD=$P(S9,U,11)
- I RMPFCERU,$D(^VA(200,RMPFCERU,0)) S RMPFCERU=$P(^(0),U,1)
- I RMPFCERD S RMPFCERD=$E(RMPFCERD,4,5)_"-"_$E(RMPFCERD,6,7)_"-"_($E(RMPFCERD,1,3)+1700)
- D ARRAY2
- S:RMPFHAT'="X" RMPFTOT=RMPFTOT+(RMPFCOST*QT)
- I IOST?1"C-".E,$Y>21 D CONT G END:$D(RMPFOUT) W @IOF,!,"cont.",!
- D @("PRT"_RMPFHAT_U_"RMPFDT3") Q
- TOT I $P(^RMPF(791810.1,RMPFTYP,0),U,6) S RMPFTOT=$J(RMPFTOT,0,2) W !?6,"Total Price: ","$"_RMPFTOT
- I RMPFHAT="C" S X=$P(^RMPF(791810,RMPFX,0),U,7) I X'="" W:$X>30 ! W ?49,"Purchase Order No.: ",X
- I $D(CN) S CN=CN+1
- END K RMPFTOT,RMPFIT,RMPFITP,RMPFMAK,RMPFCOST,RMPFLR,RMPFSN,RMPFCOM,RMPFN
- K RMPFCOMC,RMPFREP,RMPFBAT,RMPFISDP,RMPFY,RMPFOB,CY
- K RMPFTOL,RMPFC,RMPFACQD,RMPFISRE,RMPFOD,RMPFQTY,RMPFRDC,RMPFCUR,QT
- K RMPFBAT2,RMPFRED,RMPFRACT,RMPFS,RMPFTOI,RMPFCARE,RMPFCAR
- K RMPFCERD,RMPFCERU,RMPFDIS,RMPFDSN,RMPFLIS,RMPFPCT,RMPFPG,RMPFPSC,RMPFTT
- K T,J,CS,CT,S1,S2,S3,S4,S9,I,K,X,Y,CM Q
- Q
- ARRAY ;; input: RMPFX
- ;;output: RMPFO
- S RMPFY=0 K RMPFO
- AR1 S RMPFY=$O(^RMPF(791810,RMPFX,101,RMPFY)) G ARE:'RMPFY
- G AR1:'$D(^RMPF(791810,RMPFX,101,RMPFY,0)) S S0=^(0)
- S TY=$P(S0,U,15) S:TY="" TY="O" S RL=$P(S0,U,16)
- S:RL="" RL=RMPFY
- S:TY["O"!(TY="C") RMPFO(RMPFY)=$P(S0,U,18)
- I TY["D" K RMPFO(RL)
- G AR1
- ARE K RMPFY,S0,TY,RL Q
- ARRAY2 ;; input: RMPFX,RMPFY
- ;;output: RMPFC
- K RMPFC S RMPFZ=0
- AR2 S RMPFZ=$O(^RMPF(791810,RMPFX,101,RMPFY,102,RMPFZ)) G AR2E:'RMPFZ
- S S0=^RMPF(791810,RMPFX,101,RMPFY,102,RMPFZ,0),CM=$P(S0,U,1)
- S CS=$P(S0,U,2),TY=$P(S0,U,3),RL=$P(S0,U,4)
- S:TY="" TY="O" S:RL="" RL=RMPFZ
- S:TY="O"!(TY="A") RMPFC(RMPFZ)=CM_U_CS
- I TY="D" K RMPFC(RL)
- G AR2
- AR2E K RMPFZ,S0,TY,RL,CS,CM Q
- READ K RMPFOUT,RMPFQUT
- R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
- I Y?1"^".E S (RMPFOUT,Y)="" Q
- S:Y?1"?".E (RMPFQUT,Y)=""
- Q
- HEAD I $D(RMPFEDIT),$D(CN) W "[",CN,"]" S CN=CN+1
- W ?6,"Make",?17,"Model",?27,"Price"
- W !?4,"--------",?14,"-----------",?27,"------"
- Q
- HEAD1 W @IOF,!!?6,"Make",?17,"Model",?27,"Price",?36,"Component",?47,"Com Cst",?56,"Iss. Dt.",?66,"E",?74,"Repl. SN" D LINE^RMPFDT3 Q
- CONT W !,"Enter <RETURN> to continue or <^> to exit: " D READ
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDT2 4605 printed Mar 13, 2025@21:40:58 Page 2
- RMPFDT2 ;DDC/KAW-DISPLAY MODELS; [ 03/12/98 7:46 AM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**10**;JUN 16, 1995
- +2 ;;input: RMPFX,RMPFHAT,RMPFTYP
- +3 ;;output: RMPFMD,CX,RMPFO
- +4 IF $DATA(RMPFX)
- IF RMPFX
- +5 IF '$TEST
- QUIT
- +6 IF '$ORDER(^RMPF(791810,RMPFX,101,0))
- DO HEAD
- GOTO END
- +7 DO ARRAY
- +8 SET (RMPFY,CX,RMPFTOT)=0
- KILL RMPFMD
- D1 SET RMPFY=$ORDER(RMPFO(RMPFY))
- if RMPFY=""
- GOTO TOT
- DO SHOW
- GOTO D1
- SHOW if '$DATA(^RMPF(791810,RMPFX,101,RMPFY,0))
- QUIT
- SET S1=^(0)
- SET S4=$GET(^(3))
- SET RMPFIT=$PIECE(S1,U,1)
- SET CT=0
- +1 if 'RMPFIT
- QUIT
- if '$DATA(^RMPF(791811,RMPFIT,0))
- QUIT
- SET S2=^(0)
- +2 SET RMPFTT=$PIECE(S4,U,1)
- SET RMPFDIS=$PIECE(S4,U,2)
- +3 IF $LENGTH(RMPFDIS)
- SET RMPFDIS=$PIECE($GET(^RMPR(662,RMPFDIS,0)),U,1)
- +4 SET RMPFDSN=$PIECE(S4,U,3)
- SET X=$PIECE(S4,U,4)
- SET (RMPFPCT,RMPFPSC)=""
- +5 IF X
- SET RMPFPCT=$SELECT(X=1:"SC/OP",X=2:"SC/IP",X=3:"NSC/IP",X=4:"NSC/OP",1:"")
- +6 SET X=$PIECE(S4,U,5)
- IF X
- SET RMPFPSC=$SELECT(X=1:"Spec",X=2:"A&A",X=3:"PHC",1:"")
- +7 SET CX=CX+1
- KILL RMPFN,RMPFC
- +8 SET RMPFITP=$PIECE(S2,U,1)
- SET RMPFMAK=$PIECE(S2,U,2)
- +9 SET RMPFCOST=$JUSTIFY($PIECE(S1,U,14),0,2)
- SET RMPFLR=$PIECE(S1,U,4)
- +10 SET RMPFRACT=$PIECE(S1,U,9)
- SET RMPFRACT=$SELECT(RMPFRACT="D":"DEFECTIVE",RMPFRACT="R":"REDUCE STOCK",1:"")
- +11 SET RMPFACQD=""
- SET Y=$PIECE(S1,U,3)
- IF Y
- SET RMPFACQD=$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,7)_"-"_($EXTRACT(Y,1,3)+1700)
- +12 SET X=$PIECE(S1,U,8)
- SET RMPFISDP=""
- IF X
- SET RMPFISDP=$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)_"-"_($EXTRACT(X,1,3)+1700)
- +13 SET RMPFSN=$PIECE(S1,U,5)
- SET RMPFBAT=$PIECE(S1,U,2)
- SET RMPFLIS=$PIECE(S1,U,18)
- +14 IF RMPFLIS
- IF $DATA(^RMPF(791810.2,RMPFLIS,0))
- SET RMPFLIS=$PIECE(^(0),U,4)
- +15 SET RMPFTOI=$PIECE(S1,U,7)
- SET RMPFTOI=$SELECT(RMPFTOI="T":"TEMPORARY",RMPFTOI="P":"PERMANENT",1:"")
- SET (RMPFQTY,QT)=$PIECE(S1,U,6)
- if 'QT
- SET QT=1
- +16 SET RMPFRED=""
- SET Y=$PIECE(S1,U,13)
- IF Y?7N
- SET RMPFRED=$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,7)_"-"_($EXTRACT(Y,1,3)+1700)
- +17 SET RMPFOB=$PIECE(S1,U,11)
- SET RMPFTOL=$PIECE(S1,U,10)
- +18 SET RMPFISRE=$PIECE(S1,U,12)
- SET RMPFISRE=$SELECT(RMPFISRE="P":"PERMANENT ISSUE",RMPFISRE="R":"RECOVERY",RMPFISRE="T":"TEMPORARY ISSUE",RMPFISRE="S":"STATION LOANER",1:"")
- +19 SET S3=$GET(^RMPF(791810,RMPFX,101,RMPFY,2))
- +20 IF RMPFIT=1
- SET RMPFMAK=$PIECE(S3,U,1)
- SET RMPFITP=$PIECE(S3,U,2)
- +21 IF RMPFBAT
- IF $DATA(^RMPF(791811.3,RMPFBAT,0))
- SET RMPFBAT=$PIECE(^(0),U,1)
- +22 SET RMPFBAT2=$PIECE(S3,U,3)
- IF RMPFBAT2
- IF $DATA(^RMPF(791811.3,RMPFBAT2,0))
- SET RMPFBAT2=$PIECE(^(0),U,1)
- +23 SET RMPFPG=$PIECE(S3,U,4)
- IF RMPFPG
- IF $DATA(^RMPF(791811.1,RMPFPG,0))
- SET RMPFPG=$PIECE(^(0),U,1)
- +24 SET RMPFMD(CX)=RMPFY
- +25 SET X=0
- FOR I=1:1
- SET X=$ORDER(^RMPF(791810,RMPFX,101,RMPFY,101,X))
- if 'X
- QUIT
- IF $DATA(^(X,0))
- IF $PIECE(^(0),U)'=""
- SET RMPFN(I)=$PIECE(^(0),U,1)
- +26 SET S9=$GET(^RMPF(791810,RMPFX,101,RMPFY,90))
- SET RMPFRDC=$PIECE(S9,U,6)
- +27 IF RMPFRDC
- SET RMPFRDC=$EXTRACT(RMPFRDC,4,5)_"-"_$EXTRACT(RMPFRDC,6,7)_"-"_($EXTRACT(RMPFRDC,1,3)+1700)
- +28 SET RMPFCUR=$PIECE(S9,U,5)
- SET RMPFCERU=$PIECE(S9,U,8)
- SET RMPFCERD=$PIECE(S9,U,9)
- +29 IF $PIECE(S9,U,10)
- SET RMPFCERU=$PIECE(S9,U,10)
- SET RMPFCERD=$PIECE(S9,U,11)
- +30 IF RMPFCERU
- IF $DATA(^VA(200,RMPFCERU,0))
- SET RMPFCERU=$PIECE(^(0),U,1)
- +31 IF RMPFCERD
- SET RMPFCERD=$EXTRACT(RMPFCERD,4,5)_"-"_$EXTRACT(RMPFCERD,6,7)_"-"_($EXTRACT(RMPFCERD,1,3)+1700)
- +32 DO ARRAY2
- +33 if RMPFHAT'="X"
- SET RMPFTOT=RMPFTOT+(RMPFCOST*QT)
- +34 IF IOST?1"C-".E
- IF $Y>21
- DO CONT
- if $DATA(RMPFOUT)
- GOTO END
- WRITE @IOF,!,"cont.",!
- +35 DO @("PRT"_RMPFHAT_U_"RMPFDT3")
- QUIT
- TOT IF $PIECE(^RMPF(791810.1,RMPFTYP,0),U,6)
- SET RMPFTOT=$JUSTIFY(RMPFTOT,0,2)
- WRITE !?6,"Total Price: ","$"_RMPFTOT
- +1 IF RMPFHAT="C"
- SET X=$PIECE(^RMPF(791810,RMPFX,0),U,7)
- IF X'=""
- if $X>30
- WRITE !
- WRITE ?49,"Purchase Order No.: ",X
- +2 IF $DATA(CN)
- SET CN=CN+1
- END KILL RMPFTOT,RMPFIT,RMPFITP,RMPFMAK,RMPFCOST,RMPFLR,RMPFSN,RMPFCOM,RMPFN
- +1 KILL RMPFCOMC,RMPFREP,RMPFBAT,RMPFISDP,RMPFY,RMPFOB,CY
- +2 KILL RMPFTOL,RMPFC,RMPFACQD,RMPFISRE,RMPFOD,RMPFQTY,RMPFRDC,RMPFCUR,QT
- +3 KILL RMPFBAT2,RMPFRED,RMPFRACT,RMPFS,RMPFTOI,RMPFCARE,RMPFCAR
- +4 KILL RMPFCERD,RMPFCERU,RMPFDIS,RMPFDSN,RMPFLIS,RMPFPCT,RMPFPG,RMPFPSC,RMPFTT
- +5 KILL T,J,CS,CT,S1,S2,S3,S4,S9,I,K,X,Y,CM
- QUIT
- +6 QUIT
- ARRAY ;; input: RMPFX
- +1 ;;output: RMPFO
- +2 SET RMPFY=0
- KILL RMPFO
- AR1 SET RMPFY=$ORDER(^RMPF(791810,RMPFX,101,RMPFY))
- if 'RMPFY
- GOTO ARE
- +1 if '$DATA(^RMPF(791810,RMPFX,101,RMPFY,0))
- GOTO AR1
- SET S0=^(0)
- +2 SET TY=$PIECE(S0,U,15)
- if TY=""
- SET TY="O"
- SET RL=$PIECE(S0,U,16)
- +3 if RL=""
- SET RL=RMPFY
- +4 if TY["O"!(TY="C")
- SET RMPFO(RMPFY)=$PIECE(S0,U,18)
- +5 IF TY["D"
- KILL RMPFO(RL)
- +6 GOTO AR1
- ARE KILL RMPFY,S0,TY,RL
- QUIT
- ARRAY2 ;; input: RMPFX,RMPFY
- +1 ;;output: RMPFC
- +2 KILL RMPFC
- SET RMPFZ=0
- AR2 SET RMPFZ=$ORDER(^RMPF(791810,RMPFX,101,RMPFY,102,RMPFZ))
- if 'RMPFZ
- GOTO AR2E
- +1 SET S0=^RMPF(791810,RMPFX,101,RMPFY,102,RMPFZ,0)
- SET CM=$PIECE(S0,U,1)
- +2 SET CS=$PIECE(S0,U,2)
- SET TY=$PIECE(S0,U,3)
- SET RL=$PIECE(S0,U,4)
- +3 if TY=""
- SET TY="O"
- if RL=""
- SET RL=RMPFZ
- +4 if TY="O"!(TY="A")
- SET RMPFC(RMPFZ)=CM_U_CS
- +5 IF TY="D"
- KILL RMPFC(RL)
- +6 GOTO AR2
- AR2E KILL RMPFZ,S0,TY,RL,CS,CM
- QUIT
- READ KILL RMPFOUT,RMPFQUT
- +1 READ Y:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- READ Y:5
- if Y="."
- GOTO READ
- if '$TEST
- SET Y=U
- +2 IF Y?1"^".E
- SET (RMPFOUT,Y)=""
- QUIT
- +3 if Y?1"?".E
- SET (RMPFQUT,Y)=""
- +4 QUIT
- HEAD IF $DATA(RMPFEDIT)
- IF $DATA(CN)
- WRITE "[",CN,"]"
- SET CN=CN+1
- +1 WRITE ?6,"Make",?17,"Model",?27,"Price"
- +2 WRITE !?4,"--------",?14,"-----------",?27,"------"
- +3 QUIT
- HEAD1 WRITE @IOF,!!?6,"Make",?17,"Model",?27,"Price",?36,"Component",?47,"Com Cst",?56,"Iss. Dt.",?66,"E",?74,"Repl. SN"
- DO LINE^RMPFDT3
- QUIT
- CONT WRITE !,"Enter <RETURN> to continue or <^> to exit: "
- DO READ
- +1 QUIT
