| 1 | RMPFQT ;DDC/KAW-QUEUE A BATCH FOR TRANSMISSION [ 09/03/97 3:16 PM ]
|
---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;JUN 16, 1995
|
---|
| 3 | ;;Reference to ^VA(200) supported by DBIA #10060
|
---|
| 4 | ;;Reference to ^DIC(4.2) supported by DBIA #248
|
---|
| 5 | RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
|
---|
| 6 | I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
|
---|
| 7 | W @IOF,!!,"QUEUE A BATCH FOR TRANSMISSION"
|
---|
| 8 | W !!,"This option will allow you to queue the transmission of a batch"
|
---|
| 9 | W !,"to the VA Denver Distribution Center. Only batches with the status"
|
---|
| 10 | W !,"CLOSED, QUEUED FOR TRANSMISSION or TRANSMITTED may be chosen."
|
---|
| 11 | S XMINST=$O(^DIC(4.2,"B","DDC.VA.GOV",0)) I XMINST,$D(^DIC(4.2,XMINST,0))
|
---|
| 12 | E W !!,"*** 'DDC.VA.GOV' DOMAIN NOT SET UP FOR TRANSMISSION ***" H 2 G END
|
---|
| 13 | F I=1:1 Q:$Y>21 W !
|
---|
| 14 | W !!,"Enter <RETURN> to continue. " D READ G END:$D(RMPFOUT)
|
---|
| 15 | DISP K RMPFS S (RMPFS(4),RMPFS(2),RMPFS(3))="" D DISP^RMPFDB G SHOW:$D(RMPFBT)
|
---|
| 16 | I '$D(RMPFB) W !!,"*** NO BATCHES AVAILABLE ***" G END
|
---|
| 17 | D SEL^RMPFDB G END:$D(RMPFOUT)!'$D(RMPFBT)
|
---|
| 18 | SHOW W !!,"Display batch entries? YES// " D READ
|
---|
| 19 | G END:$D(RMPFOUT)
|
---|
| 20 | SHOW1 I $D(RMPFQUT) W !!,"Enter <Y> or <RETURN> to display entries in the batch or <N> to continue." G SHOW
|
---|
| 21 | S:Y="" Y="Y" I "YyNn"'[Y S RMPFQUT="" G SHOW1
|
---|
| 22 | G CONT:"Nn"[Y D ^RMPFDB1
|
---|
| 23 | CONT W !!,"Do you wish to continue with the transmission? NO// "
|
---|
| 24 | D READ G END:$D(RMPFOUT)
|
---|
| 25 | CONT1 I $D(RMPFQUT) W !!,"Enter a <Y> to transmit the batch, <N> or <RETURN> to avoid transmission." G CONT
|
---|
| 26 | S:Y="" Y="N" S Y=$E(Y,1) I "NnYy"'[Y S RMPFQUT="" G CONT1
|
---|
| 27 | G END:"Yy"'[Y D STAT,AUTOQ
|
---|
| 28 | W !!,"*** Queued for Transmission ***",! G END
|
---|
| 29 | AUTOQ ;;Automatic queueing of transmission batch
|
---|
| 30 | ;; input: RMPFBT
|
---|
| 31 | ;;output: None
|
---|
| 32 | S XMINST=$O(^DIC(4.2,"B","DDC.VA.GOV",0)) I XMINST,$D(^DIC(4.2,XMINST,0))
|
---|
| 33 | E G END
|
---|
| 34 | S RMPFP3=$P(RMPFSYS,U,3)
|
---|
| 35 | S ZTRTN="TRANS^RMPFQT",ZTIO="",ZTDESC="DDC ORDER"
|
---|
| 36 | I RMPFP3="I"!(RMPFP3="")!(RMPFP3="A") S ZTDTH=$H
|
---|
| 37 | I RMPFP3="S" S ZTDTH=$S($P(RMPFSYS,U,4)?1"."1N.4N:DT_$P(RMPFSYS,U,4),1:$H)
|
---|
| 38 | S ZTSAVE("RMPFBT")=RMPFBT,ZTSAVE("RMPFSTAP")=RMPFSTAP,ZTSAVE("XMINST")=XMINST,ZTSAVE("RMPFSYS")="",ZTSAVE("RMPFMENU")=""
|
---|
| 39 | D ^%ZTLOAD
|
---|
| 40 | S DIE="^RMPF(791812,",DA=RMPFBT,DR=".02////4" D ^DIE
|
---|
| 41 | S X="NOW",%DT="T" D ^%DT
|
---|
| 42 | S DIE="^RMPF(791810,",DR=".03////9;.06////"_Y,II=0
|
---|
| 43 | 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
|
---|
| 44 | END K RMPFP3,RMPFSIG,RMPFS,RMPFB,RMPFBT,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTDTH
|
---|
| 45 | K RMPFOUT,RMPFQUT,ZTSK,%,%T,D,D0,DA,DI,DIC,DIE,DQ,DR,I,II
|
---|
| 46 | K XMINST,TD,X,Y,%H Q
|
---|
| 47 | READ K RMPFOUT,RMPFQUT
|
---|
| 48 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
---|
| 49 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
---|
| 50 | S:Y?1"?".E (RMPFQUT,Y)=""
|
---|
| 51 | Q
|
---|
| 52 | TRANS ;;Build and send message with ROES orders
|
---|
| 53 | ;; input: RMPFBT
|
---|
| 54 | ;;output: None
|
---|
| 55 | Q:'$D(^RMPF(791812,RMPFBT,0))
|
---|
| 56 | S XMDUZ=DUZ,XMDUN=$P(^VA(200,DUZ,0),U,1)
|
---|
| 57 | S XMSUB="VADDC TRANS-"_RMPFSTAP_"-"_$P(^RMPF(791812,RMPFBT,0),U,1)
|
---|
| 58 | D XMZ^XMA2 Q:XMZ=-1 S X="NOW",%DT="T" D ^%DT
|
---|
| 59 | S DIE="^RMPF(791812,",DA=RMPFBT,DR=".06////"_XMZ_";.07////"_Y_";.02////3" D ^DIE
|
---|
| 60 | D ^RMPFQT1
|
---|
| 61 | S XMY("S.RMPFAUTO-READ@DDC.VA.GOV")=XMINST D ENT1^XMD
|
---|
| 62 | TRANSE K XMDUZ,XMSUB,XMTEXT,XMY,XMZ,DIE,DR,D0,DI,DQ,DR,DA,D,X,Y Q
|
---|
| 63 | STAT ;;change status of lines to be sent to APROVED if batch status=transmitted
|
---|
| 64 | Q:$P(^RMPF(791812,RMPFBT,0),U,2)'=3
|
---|
| 65 | S APP=$O(^RMPF(791810.2,"B","APPROVED",0)) Q:'APP
|
---|
| 66 | S J=0 F S J=$O(^RMPF(791812,RMPFBT,101,J)) Q:'J D
|
---|
| 67 | .Q:'$D(^(J,0)) S RMPFX=$P(^(0),U,1) Q:'RMPFX Q:'$D(^RMPF(791810,RMPFX,0)) D
|
---|
| 68 | ..S RMPFY=0 F S RMPFY=$O(^RMPF(791810,RMPFX,101,RMPFY)) Q:'RMPFY D
|
---|
| 69 | ...S ST=$P($G(^(RMPFY,0)),U,18) Q:'ST S STP=$P($G(^RMPF(791810.2,ST,0)),U,1)
|
---|
| 70 | ...I $P(STP,"-",2)="TRANS" S $P(^RMPF(791810,RMPFX,101,RMPFY,0),U,18)=APP
|
---|
| 71 | STATE K RMPFX,RMPFY,J,ST,STP Q
|
---|