- RMPFQT ;DDC/KAW-QUEUE A BATCH FOR TRANSMISSION [ 09/03/97 3:16 PM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;JUN 16, 1995
- ;;Reference to ^VA(200) supported by DBIA #10060
- ;;Reference to ^DIC(4.2) supported by DBIA #248
- RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
- I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
- W @IOF,!!,"QUEUE A BATCH FOR TRANSMISSION"
- W !!,"This option will allow you to queue the transmission of a batch"
- W !,"to the VA Denver Distribution Center. Only batches with the status"
- W !,"CLOSED, QUEUED FOR TRANSMISSION or TRANSMITTED may be chosen."
- S XMINST=$O(^DIC(4.2,"B","DDC.DOMAIN.EXT",0)) I XMINST,$D(^DIC(4.2,XMINST,0))
- E W !!,"*** 'DDC.DOMAIN.EXT' DOMAIN NOT SET UP FOR TRANSMISSION ***" H 2 G END
- F I=1:1 Q:$Y>21 W !
- W !!,"Enter <RETURN> to continue. " D READ G END:$D(RMPFOUT)
- DISP K RMPFS S (RMPFS(4),RMPFS(2),RMPFS(3))="" D DISP^RMPFDB G SHOW:$D(RMPFBT)
- I '$D(RMPFB) W !!,"*** NO BATCHES AVAILABLE ***" G END
- D SEL^RMPFDB G END:$D(RMPFOUT)!'$D(RMPFBT)
- SHOW W !!,"Display batch entries? YES// " D READ
- G END:$D(RMPFOUT)
- SHOW1 I $D(RMPFQUT) W !!,"Enter <Y> or <RETURN> to display entries in the batch or <N> to continue." G SHOW
- S:Y="" Y="Y" I "YyNn"'[Y S RMPFQUT="" G SHOW1
- G CONT:"Nn"[Y D ^RMPFDB1
- CONT W !!,"Do you wish to continue with the transmission? NO// "
- D READ G END:$D(RMPFOUT)
- CONT1 I $D(RMPFQUT) W !!,"Enter a <Y> to transmit the batch, <N> or <RETURN> to avoid transmission." G CONT
- S:Y="" Y="N" S Y=$E(Y,1) I "NnYy"'[Y S RMPFQUT="" G CONT1
- G END:"Yy"'[Y D STAT,AUTOQ
- W !!,"*** Queued for Transmission ***",! G END
- AUTOQ ;;Automatic queueing of transmission batch
- ;; input: RMPFBT
- ;;output: None
- S XMINST=$O(^DIC(4.2,"B","DDC.DOMAIN.EXT",0)) I XMINST,$D(^DIC(4.2,XMINST,0))
- E G END
- S RMPFP3=$P(RMPFSYS,U,3)
- S ZTRTN="TRANS^RMPFQT",ZTIO="",ZTDESC="DDC ORDER"
- I RMPFP3="I"!(RMPFP3="")!(RMPFP3="A") S ZTDTH=$H
- I RMPFP3="S" S ZTDTH=$S($P(RMPFSYS,U,4)?1"."1N.4N:DT_$P(RMPFSYS,U,4),1:$H)
- S ZTSAVE("RMPFBT")=RMPFBT,ZTSAVE("RMPFSTAP")=RMPFSTAP,ZTSAVE("XMINST")=XMINST,ZTSAVE("RMPFSYS")="",ZTSAVE("RMPFMENU")=""
- D ^%ZTLOAD
- S DIE="^RMPF(791812,",DA=RMPFBT,DR=".02////4" D ^DIE
- S X="NOW",%DT="T" D ^%DT
- S DIE="^RMPF(791810,",DR=".03////9;.06////"_Y,II=0
- F I=1:1 S II=$O(^RMPF(791812,RMPFBT,101,II)) Q:'II I $D(^RMPF(791812,RMPFBT,101,II,0)),'$P(^(0),U,2) S DA=$P(^(0),U,1) D ^DIE:DA
- END K RMPFP3,RMPFSIG,RMPFS,RMPFB,RMPFBT,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTDTH
- K RMPFOUT,RMPFQUT,ZTSK,%,%T,D,D0,DA,DI,DIC,DIE,DQ,DR,I,II
- K XMINST,TD,X,Y,%H 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
- TRANS ;;Build and send message with ROES orders
- ;; input: RMPFBT
- ;;output: None
- Q:'$D(^RMPF(791812,RMPFBT,0))
- S XMDUZ=DUZ,XMDUN=$P(^VA(200,DUZ,0),U,1)
- S XMSUB="VADDC TRANS-"_RMPFSTAP_"-"_$P(^RMPF(791812,RMPFBT,0),U,1)
- D XMZ^XMA2 Q:XMZ=-1 S X="NOW",%DT="T" D ^%DT
- S DIE="^RMPF(791812,",DA=RMPFBT,DR=".06////"_XMZ_";.07////"_Y_";.02////3" D ^DIE
- D ^RMPFQT1
- S XMY("S.RMPFAUTO-READ@DDC.DOMAIN.EXT")=XMINST D ENT1^XMD
- TRANSE K XMDUZ,XMSUB,XMTEXT,XMY,XMZ,DIE,DR,D0,DI,DQ,DR,DA,D,X,Y Q
- STAT ;;change status of lines to be sent to APROVED if batch status=transmitted
- Q:$P(^RMPF(791812,RMPFBT,0),U,2)'=3
- S APP=$O(^RMPF(791810.2,"B","APPROVED",0)) Q:'APP
- S J=0 F S J=$O(^RMPF(791812,RMPFBT,101,J)) Q:'J D
- .Q:'$D(^(J,0)) S RMPFX=$P(^(0),U,1) Q:'RMPFX Q:'$D(^RMPF(791810,RMPFX,0)) D
- ..S RMPFY=0 F S RMPFY=$O(^RMPF(791810,RMPFX,101,RMPFY)) Q:'RMPFY D
- ...S ST=$P($G(^(RMPFY,0)),U,18) Q:'ST S STP=$P($G(^RMPF(791810.2,ST,0)),U,1)
- ...I $P(STP,"-",2)="TRANS" S $P(^RMPF(791810,RMPFX,101,RMPFY,0),U,18)=APP
- STATE K RMPFX,RMPFY,J,ST,STP Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFQT 3897 printed Mar 13, 2025@21:42:02 Page 2
- RMPFQT ;DDC/KAW-QUEUE A BATCH FOR TRANSMISSION [ 09/03/97 3:16 PM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;JUN 16, 1995
- +2 ;;Reference to ^VA(200) supported by DBIA #10060
- +3 ;;Reference to ^DIC(4.2) supported by DBIA #248
- RMPFSET ;;RMPFMENU must be defined
- IF '$DATA(RMPFMENU)
- DO MENU^RMPFUTL
- IF '$DATA(RMPFMENU)
- WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
- QUIT
- +1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- DO ^RMPFUTL
- if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- QUIT
- +2 WRITE @IOF,!!,"QUEUE A BATCH FOR TRANSMISSION"
- +3 WRITE !!,"This option will allow you to queue the transmission of a batch"
- +4 WRITE !,"to the VA Denver Distribution Center. Only batches with the status"
- +5 WRITE !,"CLOSED, QUEUED FOR TRANSMISSION or TRANSMITTED may be chosen."
- +6 SET XMINST=$ORDER(^DIC(4.2,"B","DDC.DOMAIN.EXT",0))
- IF XMINST
- IF $DATA(^DIC(4.2,XMINST,0))
- +7 IF '$TEST
- WRITE !!,"*** 'DDC.DOMAIN.EXT' DOMAIN NOT SET UP FOR TRANSMISSION ***"
- HANG 2
- GOTO END
- +8 FOR I=1:1
- if $Y>21
- QUIT
- WRITE !
- +9 WRITE !!,"Enter <RETURN> to continue. "
- DO READ
- if $DATA(RMPFOUT)
- GOTO END
- DISP KILL RMPFS
- SET (RMPFS(4),RMPFS(2),RMPFS(3))=""
- DO DISP^RMPFDB
- if $DATA(RMPFBT)
- GOTO SHOW
- +1 IF '$DATA(RMPFB)
- WRITE !!,"*** NO BATCHES AVAILABLE ***"
- GOTO END
- +2 DO SEL^RMPFDB
- if $DATA(RMPFOUT)!'$DATA(RMPFBT)
- GOTO END
- SHOW WRITE !!,"Display batch entries? YES// "
- DO READ
- +1 if $DATA(RMPFOUT)
- GOTO END
- SHOW1 IF $DATA(RMPFQUT)
- WRITE !!,"Enter <Y> or <RETURN> to display entries in the batch or <N> to continue."
- GOTO SHOW
- +1 if Y=""
- SET Y="Y"
- IF "YyNn"'[Y
- SET RMPFQUT=""
- GOTO SHOW1
- +2 if "Nn"[Y
- GOTO CONT
- DO ^RMPFDB1
- CONT WRITE !!,"Do you wish to continue with the transmission? NO// "
- +1 DO READ
- if $DATA(RMPFOUT)
- GOTO END
- CONT1 IF $DATA(RMPFQUT)
- WRITE !!,"Enter a <Y> to transmit the batch, <N> or <RETURN> to avoid transmission."
- GOTO CONT
- +1 if Y=""
- SET Y="N"
- SET Y=$EXTRACT(Y,1)
- IF "NnYy"'[Y
- SET RMPFQUT=""
- GOTO CONT1
- +2 if "Yy"'[Y
- GOTO END
- DO STAT
- DO AUTOQ
- +3 WRITE !!,"*** Queued for Transmission ***",!
- GOTO END
- AUTOQ ;;Automatic queueing of transmission batch
- +1 ;; input: RMPFBT
- +2 ;;output: None
- +3 SET XMINST=$ORDER(^DIC(4.2,"B","DDC.DOMAIN.EXT",0))
- IF XMINST
- IF $DATA(^DIC(4.2,XMINST,0))
- +4 IF '$TEST
- GOTO END
- +5 SET RMPFP3=$PIECE(RMPFSYS,U,3)
- +6 SET ZTRTN="TRANS^RMPFQT"
- SET ZTIO=""
- SET ZTDESC="DDC ORDER"
- +7 IF RMPFP3="I"!(RMPFP3="")!(RMPFP3="A")
- SET ZTDTH=$HOROLOG
- +8 IF RMPFP3="S"
- SET ZTDTH=$SELECT($PIECE(RMPFSYS,U,4)?1"."1N.4N:DT_$PIECE(RMPFSYS,U,4),1:$HOROLOG)
- +9 SET ZTSAVE("RMPFBT")=RMPFBT
- SET ZTSAVE("RMPFSTAP")=RMPFSTAP
- SET ZTSAVE("XMINST")=XMINST
- SET ZTSAVE("RMPFSYS")=""
- SET ZTSAVE("RMPFMENU")=""
- +10 DO ^%ZTLOAD
- +11 SET DIE="^RMPF(791812,"
- SET DA=RMPFBT
- SET DR=".02////4"
- DO ^DIE
- +12 SET X="NOW"
- SET %DT="T"
- DO ^%DT
- +13 SET DIE="^RMPF(791810,"
- SET DR=".03////9;.06////"_Y
- SET II=0
- +14 FOR I=1:1
- SET II=$ORDER(^RMPF(791812,RMPFBT,101,II))
- if 'II
- QUIT
- IF $DATA(^RMPF(791812,RMPFBT,101,II,0))
- IF '$PIECE(^(0),U,2)
- SET DA=$PIECE(^(0),U,1)
- if DA
- DO ^DIE
- END KILL RMPFP3,RMPFSIG,RMPFS,RMPFB,RMPFBT,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTDTH
- +1 KILL RMPFOUT,RMPFQUT,ZTSK,%,%T,D,D0,DA,DI,DIC,DIE,DQ,DR,I,II
- +2 KILL XMINST,TD,X,Y,%H
- 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
- TRANS ;;Build and send message with ROES orders
- +1 ;; input: RMPFBT
- +2 ;;output: None
- +3 if '$DATA(^RMPF(791812,RMPFBT,0))
- QUIT
- +4 SET XMDUZ=DUZ
- SET XMDUN=$PIECE(^VA(200,DUZ,0),U,1)
- +5 SET XMSUB="VADDC TRANS-"_RMPFSTAP_"-"_$PIECE(^RMPF(791812,RMPFBT,0),U,1)
- +6 DO XMZ^XMA2
- if XMZ=-1
- QUIT
- SET X="NOW"
- SET %DT="T"
- DO ^%DT
- +7 SET DIE="^RMPF(791812,"
- SET DA=RMPFBT
- SET DR=".06////"_XMZ_";.07////"_Y_";.02////3"
- DO ^DIE
- +8 DO ^RMPFQT1
- +9 SET XMY("S.RMPFAUTO-READ@DDC.DOMAIN.EXT")=XMINST
- DO ENT1^XMD
- TRANSE KILL XMDUZ,XMSUB,XMTEXT,XMY,XMZ,DIE,DR,D0,DI,DQ,DR,DA,D,X,Y
- QUIT
- STAT ;;change status of lines to be sent to APROVED if batch status=transmitted
- +1 if $PIECE(^RMPF(791812,RMPFBT,0),U,2)'=3
- QUIT
- +2 SET APP=$ORDER(^RMPF(791810.2,"B","APPROVED",0))
- if 'APP
- QUIT
- +3 SET J=0
- FOR
- SET J=$ORDER(^RMPF(791812,RMPFBT,101,J))
- if 'J
- QUIT
- Begin DoDot:1
- +4 if '$DATA(^(J,0))
- QUIT
- SET RMPFX=$PIECE(^(0),U,1)
- if 'RMPFX
- QUIT
- if '$DATA(^RMPF(791810,RMPFX,0))
- QUIT
- Begin DoDot:2
- +5 SET RMPFY=0
- FOR
- SET RMPFY=$ORDER(^RMPF(791810,RMPFX,101,RMPFY))
- if 'RMPFY
- QUIT
- Begin DoDot:3
- +6 SET ST=$PIECE($GET(^(RMPFY,0)),U,18)
- if 'ST
- QUIT
- SET STP=$PIECE($GET(^RMPF(791810.2,ST,0)),U,1)
- +7 IF $PIECE(STP,"-",2)="TRANS"
- SET $PIECE(^RMPF(791810,RMPFX,101,RMPFY,0),U,18)=APP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- STATE KILL RMPFX,RMPFY,J,ST,STP
- QUIT
