- RMPFDB1 ;DDC/KAW-DISPLAY TRANSMISSION BATCH; [ 09/03/97 3:42 PM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995
- ;; input: RMPFBT
- ;;output: RMPFB
- G END:'$D(RMPFBT),END:'$D(^RMPF(791812,RMPFBT,0)) S S0=^(0)
- S Y=$P(S0,U,1) D DD^%DT S RMPFBDT=Y,RMPFSTP="",RMPFST=$P(S0,U,2)
- S RMPFSTP=$S(RMPFST=1:"OPEN",RMPFST=2:"CLOSED",RMPFST=3:"TRANSMITTED",RMPFST=4:"RECEIVED BY DDC",1:"")
- S RMPFBNA=$P(S0,U,4) D HEAD S (CT,RMPFBJ)=0
- A1 S RMPFBJ=$O(^RMPF(791812,RMPFBT,101,RMPFBJ)) G B1:'RMPFBJ,A1:'$D(^(RMPFBJ,0)) S S0=^(0),RMPFDU=$P(S0,U,2),RMPFDUP=""
- I RMPFDU,$D(^VA(200,RMPFDU,0)) S RMPFDUP=$P(^(0),U,1)
- S RMPFDTD="",Y=$P(S0,U,3) I Y D DD^%DT S RMPFDTD=Y
- S RMPFDLR=$P(S0,U,4),RMPFX=$P(S0,U,1) G A1:'RMPFX
- S RMPFDL=$S(RMPFDUP'="":"YES",1:"")
- G A1:'$D(^RMPF(791810,RMPFX,0)) S S0=^(0),Y=$P(S0,U,1)
- D DD^%DT S RMPFTD=Y,RMPFTYP="",X=$P(S0,U,2)
- I X,$D(^RMPF(791810.1,X,0)) S RMPFTYP=$P(^(0),U,8)
- S RMPFAD=$P(S0,U,8),RMPFADP="" I RMPFAD,$D(^VA(200,RMPFAD,0)) S RMPFADP=$P(^(0),U,1)
- S DFN=$P(S0,U,4),RMPFNAM="N/A"
- I DFN D PAT^RMPFUTL
- I $Y>$S(IOST?1"C-".E:20,1:58) D CONT G END:$D(RMPFOUT),END:$D(ZTSK),END:'$D(RMPFBDT) D HEAD
- S CT=CT+1 W !,$J(CT,2),". ",$E(RMPFTD,1,18),?24,$E(RMPFTYP,1,6),?32,$E(RMPFADP,1,17),?51,$E(RMPFNAM,1,19),?74,RMPFDL S RMPFB(CT)=RMPFBJ
- I RMPFDL="YES" W !?4,"Deleted By: ",$E(RMPFDUP,1,18) W:RMPFDLR'="" ?42,"Reason: ",$E(RMPFDLR,1,30)
- G A1
- B1 W !!,"Total Orders in Batch: ",CT
- W:IOST?1"P-".E @IOF
- D:$D(IO("S")) ^%ZISC
- END K RMPFBDT,RMPFSTP,RMPFST,RMPFBNA,RMPFBJ,RMPFDU,RMPFDUP,RMPFDLR
- K RMPFX,RMPFDL,RMPFDLR,RMPFTD,RMPFTYP,RMPFAD,RMPFADP,DFN,RMPFNAM
- K RMPFDOB,RMPFSSN,RMPFDTD,RMPFDOD,S0,CT,I,X,Y Q
- HEAD W @IOF,!?17,"REMOTE ORDER/ENTRY TRANSMISSION BATCH ENTRIES"
- W !,"Station: ",RMPFSTAP,?68,RMPFDAT
- W !?2,"Batch: ",RMPFBDT,?37,"Status: ",$E(RMPFSTP,1,14),?62,"Number Active: ",$J(RMPFBNA,3)
- W ! F I=1:1:80 W "-"
- W !," #",?5,"Order Date/Time",?25,"Type",?35,"Ordered By",?57,"Patient",?72,"Deleted"
- W !,"---",?4,"------------------",?24,"------",?32,"-----------------",?51,"-------------------",?72,"--------" W !
- Q
- CONT F I=1:1 Q:$Y>20 W !
- W !,"Enter <RETURN> to continue, <P>rint or <^> to exit: " D READ
- Q:$D(RMPFOUT) I $D(RMPFQUT) D MSG^RMPFDD G CONT
- Q:Y="" S Y=$E(Y,1) G CONT:"Pp"'[Y D QUE
- Q
- QUE S ZTRTN="^RMPFDB1",ZTDESC="ORDER BATCH"
- S %ZIS="NPQ" D ^%ZIS G QUEE:POP
- I IO=IO(0),'$D(IO("S")) G RMPFDB1
- I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDB1
- S ZTSAVE("RM*")="",ZTIO=ION D ^%ZTLOAD,HOME^%ZIS
- W:$D(ZTSK) !!,"*** Request Queued ***" H 2
- QUEE 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDB1 2704 printed Feb 19, 2025@00:02:11 Page 2
- RMPFDB1 ;DDC/KAW-DISPLAY TRANSMISSION BATCH; [ 09/03/97 3:42 PM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995
- +2 ;; input: RMPFBT
- +3 ;;output: RMPFB
- +4 if '$DATA(RMPFBT)
- GOTO END
- if '$DATA(^RMPF(791812,RMPFBT,0))
- GOTO END
- SET S0=^(0)
- +5 SET Y=$PIECE(S0,U,1)
- DO DD^%DT
- SET RMPFBDT=Y
- SET RMPFSTP=""
- SET RMPFST=$PIECE(S0,U,2)
- +6 SET RMPFSTP=$SELECT(RMPFST=1:"OPEN",RMPFST=2:"CLOSED",RMPFST=3:"TRANSMITTED",RMPFST=4:"RECEIVED BY DDC",1:"")
- +7 SET RMPFBNA=$PIECE(S0,U,4)
- DO HEAD
- SET (CT,RMPFBJ)=0
- A1 SET RMPFBJ=$ORDER(^RMPF(791812,RMPFBT,101,RMPFBJ))
- if 'RMPFBJ
- GOTO B1
- if '$DATA(^(RMPFBJ,0))
- GOTO A1
- SET S0=^(0)
- SET RMPFDU=$PIECE(S0,U,2)
- SET RMPFDUP=""
- +1 IF RMPFDU
- IF $DATA(^VA(200,RMPFDU,0))
- SET RMPFDUP=$PIECE(^(0),U,1)
- +2 SET RMPFDTD=""
- SET Y=$PIECE(S0,U,3)
- IF Y
- DO DD^%DT
- SET RMPFDTD=Y
- +3 SET RMPFDLR=$PIECE(S0,U,4)
- SET RMPFX=$PIECE(S0,U,1)
- if 'RMPFX
- GOTO A1
- +4 SET RMPFDL=$SELECT(RMPFDUP'="":"YES",1:"")
- +5 if '$DATA(^RMPF(791810,RMPFX,0))
- GOTO A1
- SET S0=^(0)
- SET Y=$PIECE(S0,U,1)
- +6 DO DD^%DT
- SET RMPFTD=Y
- SET RMPFTYP=""
- SET X=$PIECE(S0,U,2)
- +7 IF X
- IF $DATA(^RMPF(791810.1,X,0))
- SET RMPFTYP=$PIECE(^(0),U,8)
- +8 SET RMPFAD=$PIECE(S0,U,8)
- SET RMPFADP=""
- IF RMPFAD
- IF $DATA(^VA(200,RMPFAD,0))
- SET RMPFADP=$PIECE(^(0),U,1)
- +9 SET DFN=$PIECE(S0,U,4)
- SET RMPFNAM="N/A"
- +10 IF DFN
- DO PAT^RMPFUTL
- +11 IF $Y>$SELECT(IOST?1"C-".E:20,1:58)
- DO CONT
- if $DATA(RMPFOUT)
- GOTO END
- if $DATA(ZTSK)
- GOTO END
- if '$DATA(RMPFBDT)
- GOTO END
- DO HEAD
- +12 SET CT=CT+1
- WRITE !,$JUSTIFY(CT,2),". ",$EXTRACT(RMPFTD,1,18),?24,$EXTRACT(RMPFTYP,1,6),?32,$EXTRACT(RMPFADP,1,17),?51,$EXTRACT(RMPFNAM,1,19),?74,RMPFDL
- SET RMPFB(CT)=RMPFBJ
- +13 IF RMPFDL="YES"
- WRITE !?4,"Deleted By: ",$EXTRACT(RMPFDUP,1,18)
- if RMPFDLR'=""
- WRITE ?42,"Reason: ",$EXTRACT(RMPFDLR,1,30)
- +14 GOTO A1
- B1 WRITE !!,"Total Orders in Batch: ",CT
- +1 if IOST?1"P-".E
- WRITE @IOF
- +2 if $DATA(IO("S"))
- DO ^%ZISC
- END KILL RMPFBDT,RMPFSTP,RMPFST,RMPFBNA,RMPFBJ,RMPFDU,RMPFDUP,RMPFDLR
- +1 KILL RMPFX,RMPFDL,RMPFDLR,RMPFTD,RMPFTYP,RMPFAD,RMPFADP,DFN,RMPFNAM
- +2 KILL RMPFDOB,RMPFSSN,RMPFDTD,RMPFDOD,S0,CT,I,X,Y
- QUIT
- HEAD WRITE @IOF,!?17,"REMOTE ORDER/ENTRY TRANSMISSION BATCH ENTRIES"
- +1 WRITE !,"Station: ",RMPFSTAP,?68,RMPFDAT
- +2 WRITE !?2,"Batch: ",RMPFBDT,?37,"Status: ",$EXTRACT(RMPFSTP,1,14),?62,"Number Active: ",$JUSTIFY(RMPFBNA,3)
- +3 WRITE !
- FOR I=1:1:80
- WRITE "-"
- +4 WRITE !," #",?5,"Order Date/Time",?25,"Type",?35,"Ordered By",?57,"Patient",?72,"Deleted"
- +5 WRITE !,"---",?4,"------------------",?24,"------",?32,"-----------------",?51,"-------------------",?72,"--------"
- WRITE !
- +6 QUIT
- CONT FOR I=1:1
- if $Y>20
- QUIT
- WRITE !
- +1 WRITE !,"Enter <RETURN> to continue, <P>rint or <^> to exit: "
- DO READ
- +2 if $DATA(RMPFOUT)
- QUIT
- IF $DATA(RMPFQUT)
- DO MSG^RMPFDD
- GOTO CONT
- +3 if Y=""
- QUIT
- SET Y=$EXTRACT(Y,1)
- if "Pp"'[Y
- GOTO CONT
- DO QUE
- +4 QUIT
- QUE SET ZTRTN="^RMPFDB1"
- SET ZTDESC="ORDER BATCH"
- +1 SET %ZIS="NPQ"
- DO ^%ZIS
- if POP
- GOTO QUEE
- +2 IF IO=IO(0)
- IF '$DATA(IO("S"))
- GOTO RMPFDB1
- +3 IF $DATA(IO("S"))
- SET %ZIS=""
- SET IOP=ION
- DO ^%ZIS
- GOTO ^RMPFDB1
- +4 SET ZTSAVE("RM*")=""
- SET ZTIO=ION
- DO ^%ZTLOAD
- DO HOME^%ZIS
- +5 if $DATA(ZTSK)
- WRITE !!,"*** Request Queued ***"
- HANG 2
- QUEE 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
