PSOPOST1 ;BHAM ISC/SAB - post routine to view status of background jobs ; 6/26/97
;;7.0;OUTPATIENT PHARMACY;**12,29,87**;DEC 1997
;External Ref. to ^ORD(101, is supp. by DBIA# 872
K %ZIS,IOP,ZTSK S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP G EX
I $D(IO("Q")) D S IOP=PSOION D ^%ZIS G EX
.S ZTDESC="Outpatient Pharmacy Background Job Status",ZTRTN="EN^PSOPOST1",ZTSAVE("ZTREQ")="@" D ^%ZTLOAD
.W:$D(ZTSK) !,"Report Queued to Print!",! K X,Y,IO("Q"),ZTSK
EN K DIC,DR,DA,DIQ,PSOPOST
S DIC=59.7,DA=1,DR=".01;49.99;49.981;49.982",DIQ="PSOPOST" D EN^DIQ1
Q
I $G(PSOPOST(59.7,1,49.99))<7 D
.K PSOPOST(59.7,1,49.981),PSOPOST(59.7,1,49.982),PSOPOST(59.7,1,49.983),PSOPOST(59.7,1,49.984)
D NOW^%DTC S $P(LINE,"-",IOM)="-",HDR="Outpatient Pharmacy Background Job Status",Y=% X ^DD("DD")
U IO W @IOF,!?1,HDR_" "_$P(Y,"@")_" "_$P(Y,"@",2)_" Page 1",!,LINE
W !?17,"Site Name: "_PSOPOST(59.7,1,.01),!?1,"Current Version Installed: "_$G(PSOPOST(59.7,1,49.99)),!
W !?1,"Background Conversion Job Started: "_$S($G(PSOPOST(59.7,1,49.981))]"":$P(PSOPOST(59.7,1,49.981),"@")_" "_$P(PSOPOST(59.7,1,49.981),"@",2),1:"Job Not Started Yet!")
W !?21,"Job Completed: "_$S($G(PSOPOST(59.7,1,49.982))]"":$P(PSOPOST(59.7,1,49.982),"@")_" "_$P(PSOPOST(59.7,1,49.982),"@",2),1:"")
EX D ^%ZISC K DIC,DR,DA,DIQ,PSOPOST,LINE,HDR,Y,X,%I,D0,PSOION
Q
OPT ;PSO*7.0*12 deletes PSO CANCEL protocol in preinstall
S DA=$O(^ORD(101,"B","PSO CANCEL",0)) I DA S DIK="^ORD(101," D ^DIK K DIK,DA
NDCM ;PSO*7*29 data conv. rout. to move data of field#11 NDC piece 13 from File 52.1(Refills) Node 0 to piece 3 of Node 1
N V1,V2
S V1=0 F S V1=$O(^PSRX(V1)) Q:'V1 S V2=0 F S V2=$O(^PSRX(V1,1,V2)) Q:'V2 S NDC=$P($G(^(V2,0)),"^",13) S:NDC]"" $P(^(1),"^",3)=NDC,$P(^(0),"^",13)=""
Q
NDC ;PSO*7.0*29 Pre-install, to remove field#11 (NDC) of file 52.1 (Refills) in order to increase the length of field#1.2 (Current Unit Price of Drug) from 99.999 to 999.9999
S DIK="^DD(52.1,",DA=11,DA(1)=52.1 D ^DIK K DIK,DA
Q
NDCQ ;Post-install display
W ! ;S DIR(0)="Y",DIR("B")="YES"
W !,"In this patch field NDC (#11) in the REFILL sub-file (#52.1) is moved to"
W !,"a new node within the multiple. The data in the old location can be moved to "
W !,"it's new location now by selecting a time to queue the background job or can be"
W !,"moved later by using the entry point NDCQ^PSOPOST1. This job can run at least"
W !,"an hour or more depending on the amount of data that is in the PRESCRIPTION"
W !,"file (#52). If you do not want to queue the background job at this time"
W !,"enter '^' at the prompt."
W !,"Be aware at this point that the cursor is hidden and the characters you enter"
W !,"here will not be seen as the whole process is under the control of KIDS."
NDCG ;PSO*7*29 post-install background bob Date/Time selection
W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue Post-install Job to run Date/Time: "
D ^%DT K %DT I $D(DTOUT)!(Y<0) G NDCX
S ZTDTH=$G(Y),ZTIO="",ZTRTN="NDCM^PSOPOST1",ZTDESC="Outpatient Pharmacy V7 Patch 29 Data Conversion",ZTIO=""
D ^%ZTLOAD W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
Q
NDCX W !!,"Task not queued !",!
Q
MISIG ;post install for PSO*7*87
F RX=0:0 S RX=$O(^PSRX(RX)) Q:'RX I $G(^PSRX(RX,"SIG"))="^",$P($G(^("OR1")),"^",3) D
.S RXN=$P(^PSRX(RX,"OR1"),"^",3) I $P($G(^PSRX(RXN,"SIG")),"^")]"" S ^PSRX(RX,"SIG")=^PSRX(RXN,"SIG") D EN^DDIOL(".","","?1")
K RX,RXN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPOST1 3498 printed Dec 13, 2024@02:32:51 Page 2
PSOPOST1 ;BHAM ISC/SAB - post routine to view status of background jobs ; 6/26/97
+1 ;;7.0;OUTPATIENT PHARMACY;**12,29,87**;DEC 1997
+2 ;External Ref. to ^ORD(101, is supp. by DBIA# 872
+3 KILL %ZIS,IOP,ZTSK
SET PSOION=ION
SET %ZIS="QM"
DO ^%ZIS
KILL %ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
KILL IOP
GOTO EX
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTDESC="Outpatient Pharmacy Background Job Status"
SET ZTRTN="EN^PSOPOST1"
SET ZTSAVE("ZTREQ")="@"
DO ^%ZTLOAD
+6 if $DATA(ZTSK)
WRITE !,"Report Queued to Print!",!
KILL X,Y,IO("Q"),ZTSK
End DoDot:1
SET IOP=PSOION
DO ^%ZIS
GOTO EX
EN KILL DIC,DR,DA,DIQ,PSOPOST
+1 SET DIC=59.7
SET DA=1
SET DR=".01;49.99;49.981;49.982"
SET DIQ="PSOPOST"
DO EN^DIQ1
+2 QUIT
+3 IF $GET(PSOPOST(59.7,1,49.99))<7
Begin DoDot:1
+4 KILL PSOPOST(59.7,1,49.981),PSOPOST(59.7,1,49.982),PSOPOST(59.7,1,49.983),PSOPOST(59.7,1,49.984)
End DoDot:1
+5 DO NOW^%DTC
SET $PIECE(LINE,"-",IOM)="-"
SET HDR="Outpatient Pharmacy Background Job Status"
SET Y=%
XECUTE ^DD("DD")
+6 USE IO
WRITE @IOF,!?1,HDR_" "_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)_" Page 1",!,LINE
+7 WRITE !?17,"Site Name: "_PSOPOST(59.7,1,.01),!?1,"Current Version Installed: "_$GET(PSOPOST(59.7,1,49.99)),!
+8 WRITE !?1,"Background Conversion Job Started: "_$SELECT($GET(PSOPOST(59.7,1,49.981))]"":$PIECE(PSOPOST(59.7,1,49.981),"@")_" "_$PIECE(PSOPOST(59.7,1,49.981),"@",2),1:"Job Not Started Yet!")
+9 WRITE !?21,"Job Completed: "_$SELECT($GET(PSOPOST(59.7,1,49.982))]"":$PIECE(PSOPOST(59.7,1,49.982),"@")_" "_$PIECE(PSOPOST(59.7,1,49.982),"@",2),1:"")
EX DO ^%ZISC
KILL DIC,DR,DA,DIQ,PSOPOST,LINE,HDR,Y,X,%I,D0,PSOION
+1 QUIT
OPT ;PSO*7.0*12 deletes PSO CANCEL protocol in preinstall
+1 SET DA=$ORDER(^ORD(101,"B","PSO CANCEL",0))
IF DA
SET DIK="^ORD(101,"
DO ^DIK
KILL DIK,DA
NDCM ;PSO*7*29 data conv. rout. to move data of field#11 NDC piece 13 from File 52.1(Refills) Node 0 to piece 3 of Node 1
+1 NEW V1,V2
+2 SET V1=0
FOR
SET V1=$ORDER(^PSRX(V1))
if 'V1
QUIT
SET V2=0
FOR
SET V2=$ORDER(^PSRX(V1,1,V2))
if 'V2
QUIT
SET NDC=$PIECE($GET(^(V2,0)),"^",13)
if NDC]""
SET $PIECE(^(1),"^",3)=NDC
SET $PIECE(^(0),"^",13)=""
+3 QUIT
NDC ;PSO*7.0*29 Pre-install, to remove field#11 (NDC) of file 52.1 (Refills) in order to increase the length of field#1.2 (Current Unit Price of Drug) from 99.999 to 999.9999
+1 SET DIK="^DD(52.1,"
SET DA=11
SET DA(1)=52.1
DO ^DIK
KILL DIK,DA
+2 QUIT
NDCQ ;Post-install display
+1 ;S DIR(0)="Y",DIR("B")="YES"
WRITE !
+2 WRITE !,"In this patch field NDC (#11) in the REFILL sub-file (#52.1) is moved to"
+3 WRITE !,"a new node within the multiple. The data in the old location can be moved to "
+4 WRITE !,"it's new location now by selecting a time to queue the background job or can be"
+5 WRITE !,"moved later by using the entry point NDCQ^PSOPOST1. This job can run at least"
+6 WRITE !,"an hour or more depending on the amount of data that is in the PRESCRIPTION"
+7 WRITE !,"file (#52). If you do not want to queue the background job at this time"
+8 WRITE !,"enter '^' at the prompt."
+9 WRITE !,"Be aware at this point that the cursor is hidden and the characters you enter"
+10 WRITE !,"here will not be seen as the whole process is under the control of KIDS."
NDCG ;PSO*7*29 post-install background bob Date/Time selection
+1 WRITE !
KILL %DT
DO NOW^%DTC
SET %DT="RAEX"
SET %DT(0)=%
SET %DT("A")="Queue Post-install Job to run Date/Time: "
+2 DO ^%DT
KILL %DT
IF $DATA(DTOUT)!(Y<0)
GOTO NDCX
+3 SET ZTDTH=$GET(Y)
SET ZTIO=""
SET ZTRTN="NDCM^PSOPOST1"
SET ZTDESC="Outpatient Pharmacy V7 Patch 29 Data Conversion"
SET ZTIO=""
+4 DO ^%ZTLOAD
if $DATA(ZTSK)&('$DATA(ZTQUEUED))
WRITE !!,"Task Queued !",!
+5 QUIT
NDCX WRITE !!,"Task not queued !",!
+1 QUIT
MISIG ;post install for PSO*7*87
+1 FOR RX=0:0
SET RX=$ORDER(^PSRX(RX))
if 'RX
QUIT
IF $GET(^PSRX(RX,"SIG"))="^"
IF $PIECE($GET(^("OR1")),"^",3)
Begin DoDot:1
+2 SET RXN=$PIECE(^PSRX(RX,"OR1"),"^",3)
IF $PIECE($GET(^PSRX(RXN,"SIG")),"^")]""
SET ^PSRX(RX,"SIG")=^PSRX(RXN,"SIG")
DO EN^DDIOL(".","","?1")
End DoDot:1
+3 KILL RX,RXN
+4 QUIT
