- PSXUNHLD ;BIR/WPB-Routine to Remove a Transmission from Hold Status ;[ 04/08/97 2:06 PM ]
- ;;2.0;CMOP;;11 Apr 97
- EN I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
- I $P($G(^PSX(553,1,"S")),"^",1)="R" W !,"The interface is running. Wait until the interface is stopped." Q
- S DIC=552.1,DIC(0)="AQMEZ"
- S DIC("S")="I $D(^PSX(552.1,""AH"",$P(^PSX(552.1,+Y,0),U,1),+Y)),($D(^PSX(552.1,+Y,2)))" D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT))!($G(Y)'>0) EXIT S BAT=+Y
- K Y,X
- S OBAT=$P($G(^PSX(552.1,BAT,2)),"^",2),OREC=$O(^PSX(552.1,"B",OBAT,""))
- I $G(OREC)="" W !,"The original transmission was not received.",! S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO" D ^DIR K DIR G:Y<1!($D(DIRUT)) EXIT G EN1
- S OLDSTAT=$P(^PSX(552.1,OREC,0),"^",2)
- ; mods for new unhold to delete retrans if original is processed
- I "7"[$G(OLDSTAT) W !!,"The original transmission, ",OBAT," is downloading to the automated",!,"vendor system.",!,"Transmission, ",$P(^PSX(552.1,BAT,0),"^",1)," is a retransmission of ",OBAT," and can not be queued." G EXIT
- I "346"[$G(OLDSTAT) D COM,EN2 G EXIT
- EN1 W !!
- S DIR(0)="Y",DIR("B")="NO",DIR("A")="UNHOLD",DIR("?")="Changing the status of this retransmission will allow the data to go to the automated vendor system for filling." D ^DIR K DIR G:$G(Y)=0!($D(DIRUT)) EXIT K Y,X
- EN2 G:$G(OREC)="" RST
- S O1=$P(^PSX(552.1,OREC,1),"^",1),O2=$P(^PSX(552.1,OREC,1),"^",2)
- I $G(O1)'="" S DIK="^PSX(552.2," F J=O1:1:O2 S MSG=OBAT_"-"_J,REC=$O(^PSX(552.2,"B",MSG,"")) Q:$G(REC)="" S DA=REC D ^DIK K REC,DA,MSG
- K DIK
- S P5524=$O(^PSX(552.4,"B",OREC,"")) Q:$G(P5524)'>0 S DIK="^PSX(552.4,",DA=P5524 D ^DIK K DA,DIK,P5524
- K ^PSX(552.1,OREC,"S") S DA=OREC,DIE="^PSX(552.1,",COM="Filled under "_$P(^PSX(552.1,BAT,0),"^",1),DR="1////4;15///"_COM D ^DIE K DIE,DA,COM,DR
- RST Q:$G(TMP)>0
- S DA=BAT,DIE="^PSX(552.1,",DR="1////2" D ^DIE K DIE,DR,DA
- S DIK="^PSX(552.1,",DA=BAT D IX^DIK K DA,DIK
- W !!,"Transmission ",$P(^PSX(552.1,BAT,0),"^")," is queued to download to the automated vendor system."
- EXIT K Y,X,DIR,DIC,TMP,DTOUT,DIROUT,DUOUT,DIRUT,BAT,OBAT,OLDSTAT,OREC,J,MSG,O1,O2
- Q
- COM W !!,"The original transmission, ",OBAT," has already been sent to the automated",!,"vendor system.",!,"Transmission, ",$P(^PSX(552.1,BAT,0),"^",1)," is a retransmission of ",OBAT," and can not be queued."
- S TMP=OREC,OREC=BAT,BAT=TMP,OBAT=$P(^PSX(552.1,OREC,0),"^")
- Q
- PSXUNHLD ;BIR/WPB-Routine to Remove a Transmission from Hold Status ;[ 04/08/97 2:06 PM ]
- +1 ;;2.0;CMOP;;11 Apr 97
- EN IF '$DATA(^XUSEC("PSXCMOPMGR",DUZ))
- WRITE !,"You are not authorized to use this option!"
- QUIT
- +1 IF $PIECE($GET(^PSX(553,1,"S")),"^",1)="R"
- WRITE !,"The interface is running. Wait until the interface is stopped."
- QUIT
- +2 SET DIC=552.1
- SET DIC(0)="AQMEZ"
- +3 SET DIC("S")="I $D(^PSX(552.1,""AH"",$P(^PSX(552.1,+Y,0),U,1),+Y)),($D(^PSX(552.1,+Y,2)))"
- DO ^DIC
- KILL DIC
- IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(Y)'>0)
- GOTO EXIT
- SET BAT=+Y
- +4 KILL Y,X
- +5 SET OBAT=$PIECE($GET(^PSX(552.1,BAT,2)),"^",2)
- SET OREC=$ORDER(^PSX(552.1,"B",OBAT,""))
- +6 IF $GET(OREC)=""
- WRITE !,"The original transmission was not received.",!
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to continue"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- IF Y<1!($DATA(DIRUT))
- GOTO EXIT
- GOTO EN1
- +7 SET OLDSTAT=$PIECE(^PSX(552.1,OREC,0),"^",2)
- +8 ; mods for new unhold to delete retrans if original is processed
- +9 IF "7"[$GET(OLDSTAT)
- WRITE !!,"The original transmission, ",OBAT," is downloading to the automated",!,"vendor system.",!,"Transmission, ",$PIECE(^PSX(552.1,BAT,0),"^",1)," is a retransmission of ",OBAT," and can not be queued."
- GOTO EXIT
- +10 IF "346"[$GET(OLDSTAT)
- DO COM
- DO EN2
- GOTO EXIT
- EN1 WRITE !!
- +1 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="UNHOLD"
- SET DIR("?")="Changing the status of this retransmission will allow the data to go to the automated vendor system for filling."
- DO ^DIR
- KILL DIR
- IF $GET(Y)=0!($DATA(DIRUT))
- GOTO EXIT
- KILL Y,X
- EN2 IF $GET(OREC)=""
- GOTO RST
- +1 SET O1=$PIECE(^PSX(552.1,OREC,1),"^",1)
- SET O2=$PIECE(^PSX(552.1,OREC,1),"^",2)
- +2 IF $GET(O1)'=""
- SET DIK="^PSX(552.2,"
- FOR J=O1:1:O2
- SET MSG=OBAT_"-"_J
- SET REC=$ORDER(^PSX(552.2,"B",MSG,""))
- IF $GET(REC)=""
- QUIT
- SET DA=REC
- DO ^DIK
- KILL REC,DA,MSG
- +3 KILL DIK
- +4 SET P5524=$ORDER(^PSX(552.4,"B",OREC,""))
- IF $GET(P5524)'>0
- QUIT
- SET DIK="^PSX(552.4,"
- SET DA=P5524
- DO ^DIK
- KILL DA,DIK,P5524
- +5 KILL ^PSX(552.1,OREC,"S")
- SET DA=OREC
- SET DIE="^PSX(552.1,"
- SET COM="Filled under "_$PIECE(^PSX(552.1,BAT,0),"^",1)
- SET DR="1////4;15///"_COM
- DO ^DIE
- KILL DIE,DA,COM,DR
- RST IF $GET(TMP)>0
- QUIT
- +1 SET DA=BAT
- SET DIE="^PSX(552.1,"
- SET DR="1////2"
- DO ^DIE
- KILL DIE,DR,DA
- +2 SET DIK="^PSX(552.1,"
- SET DA=BAT
- DO IX^DIK
- KILL DA,DIK
- +3 WRITE !!,"Transmission ",$PIECE(^PSX(552.1,BAT,0),"^")," is queued to download to the automated vendor system."
- EXIT KILL Y,X,DIR,DIC,TMP,DTOUT,DIROUT,DUOUT,DIRUT,BAT,OBAT,OLDSTAT,OREC,J,MSG,O1,O2
- +1 QUIT
- COM WRITE !!,"The original transmission, ",OBAT," has already been sent to the automated",!,"vendor system.",!,"Transmission, ",$PIECE(^PSX(552.1,BAT,0),"^",1)," is a retransmission of ",OBAT," and can not be queued."
- +1 SET TMP=OREC
- SET OREC=BAT
- SET BAT=TMP
- SET OBAT=$PIECE(^PSX(552.1,OREC,0),"^")
- +2 QUIT
