PSOPOST2 ;ISC-Bham/SAB-post routine clear data in new field in 1;9 of file 59 ; 1/20/00
;;7.0;OUTPATIENT PHARMACY;**32,46,74**;DEC 1997
;External reference to PSSORPH is supported by DBIA 3234
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference to ^PS(50.607 supported by DBIA 2221
N I F I=0:0 S I=$O(^PS(59,I)) Q:'I S $P(^PS(59,I,1),"^",9)=""
Q
EN ;PSO*7*46 checks pre-poe orders for conversion and flags all rxs as poe
S ZTREQ="@",ZTDTH=$H,ZTRTN="POE^PSOPOST2",ZTIO="",ZTDESC="Flagging All Prescriptions as POE Orders." D ^%ZTLOAD,BMES^XPDUTL("Queuing Background Job to Flag Prescriptions as POE Orders...")
D BMES^XPDUTL("Attempting to Convert Outpatient Pharmacy Pre-POE Pending Orders...")
F I=0:0 S I=$O(^PS(52.41,"AOR",I)) Q:'I F F=0:0 S F=$O(^PS(52.41,"AOR",I,F)) Q:'F F G=0:0 S G=$O(^PS(52.41,"AOR",I,F,G)) Q:'G D
.I $P(^PS(52.41,G,0),"^",3)'="NW",$P(^(0),"^",3)'="RNW",$P(^(0),"^",3)'="RF" K ^PS(52.41,"AOR",I,F,G) Q
.Q:'$P(^PS(52.41,G,0),"^",9)
.S IEN=$P(^PS(52.41,G,0),"^",9),RTE=$P(^(0),"^",15)
.K DOSE D DOSE^PSSORPH(.DOSE,IEN,"O") Q:'$D(DOSE("DD",IEN))
.S ^PS(52.41,G,"POE")=1,NOUN=$P(DOSE("DD",IEN),"^",9),VERB=$P(DOSE("DD",IEN),"^",10)
.F E=0:0 S E=$O(^PS(52.41,G,1,E)) Q:'E S DUPD=$P(^PS(52.41,G,1,E,0),"^"),DUPD=$P(DUPD,"&") D
..S:$G(RTE)]"" $P(^PS(52.41,G,1,E,1),"^",8)=RTE S $P(^PS(52.41,G,1,E,1),"^",5)=NOUN,$P(^(1),"^",10)=VERB
..I DUPD'?.N&(DUPD'?.N1".".N),$P($G(^PS(52.41,G,1,E,2)),"^")']"" S $P(^PS(52.41,G,1,E,2),"^")=DUPD Q
..I DUPD,'$P(DOSE("DD",IEN),"^",5),$P($G(^PS(52.41,G,1,E,2)),"^")']"" D Q
...S $P(^PS(52.41,G,1,E,2),"^")=DUPD_" "_NOUN
...S:$P(DOSE("DD",IEN),"^",6)]"" UNITS=$O(^PS(50.607,"B",$P(DOSE("DD",IEN),"^",6),0))
...I $G(UNITS) S $P(^PS(52.41,G,1,E,1),"^",9)=UNITS
..S:$P($G(^PS(52.41,G,1,E,2)),"^")']"" $P(^PS(52.41,G,1,E,2),"^")=DUPD*$P(DOSE("DD",IEN),"^",5)
..S:$P($G(^PS(52.41,G,1,E,2)),"^",2)']"" $P(^PS(52.41,G,1,E,2),"^",2)=DUPD
..S:$P(DOSE("DD",IEN),"^",6)]"" UNITS=$O(^PS(50.607,"B",$P(DOSE("DD",IEN),"^",6),0))
..I $G(UNITS) S $P(^PS(52.41,G,1,E,1),"^",9)=UNITS
K DOSE,I,F,G,IEN,RTE,DUPD,UNITS,NOUN,VERB,DD
Q
POE F RXN=0:0 S RXN=$O(^PSRX(RXN)) Q:'RXN I $G(^PSRX(RXN,0))]"" S ^PSRX(RXN,"POE")=1
K RXN
Q
PSOMIS ;checks for unfinished orders without drugs PSO*7*74
F I=0:0 S I=$O(^PS(52.41,"AOR",I)) Q:'I F F=0:0 S F=$O(^PS(52.41,"AOR",I,F)) Q:'F F G=0:0 S G=$O(^PS(52.41,"AOR",I,F,G)) Q:'G D
.Q:$P(^PS(52.41,G,0),"^",9)
.I $P(^PS(52.41,G,0),"^",3)'="NW",$P(^(0),"^",3)'="RNW",$P(^(0),"^",3)'="RF" K ^PS(52.41,"AOR",I,F,G) Q
.F E=0:0 S E=$O(^PS(52.41,G,1,E)) Q:'E S $P(^PS(52.41,G,1,E,1),"^",5)=""
K G,I,E,F
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPOST2 2670 printed Apr 09, 2024@21:36:10 Page 2
PSOPOST2 ;ISC-Bham/SAB-post routine clear data in new field in 1;9 of file 59 ; 1/20/00
+1 ;;7.0;OUTPATIENT PHARMACY;**32,46,74**;DEC 1997
+2 ;External reference to PSSORPH is supported by DBIA 3234
+3 ;External reference to ^PS(50.7 supported by DBIA 2223
+4 ;External reference to ^PS(50.607 supported by DBIA 2221
+5 NEW I
FOR I=0:0
SET I=$ORDER(^PS(59,I))
if 'I
QUIT
SET $PIECE(^PS(59,I,1),"^",9)=""
+6 QUIT
EN ;PSO*7*46 checks pre-poe orders for conversion and flags all rxs as poe
+1 SET ZTREQ="@"
SET ZTDTH=$HOROLOG
SET ZTRTN="POE^PSOPOST2"
SET ZTIO=""
SET ZTDESC="Flagging All Prescriptions as POE Orders."
DO ^%ZTLOAD
DO BMES^XPDUTL("Queuing Background Job to Flag Prescriptions as POE Orders...")
+2 DO BMES^XPDUTL("Attempting to Convert Outpatient Pharmacy Pre-POE Pending Orders...")
+3 FOR I=0:0
SET I=$ORDER(^PS(52.41,"AOR",I))
if 'I
QUIT
FOR F=0:0
SET F=$ORDER(^PS(52.41,"AOR",I,F))
if 'F
QUIT
FOR G=0:0
SET G=$ORDER(^PS(52.41,"AOR",I,F,G))
if 'G
QUIT
Begin DoDot:1
+4 IF $PIECE(^PS(52.41,G,0),"^",3)'="NW"
IF $PIECE(^(0),"^",3)'="RNW"
IF $PIECE(^(0),"^",3)'="RF"
KILL ^PS(52.41,"AOR",I,F,G)
QUIT
+5 if '$PIECE(^PS(52.41,G,0),"^",9)
QUIT
+6 SET IEN=$PIECE(^PS(52.41,G,0),"^",9)
SET RTE=$PIECE(^(0),"^",15)
+7 KILL DOSE
DO DOSE^PSSORPH(.DOSE,IEN,"O")
if '$DATA(DOSE("DD",IEN))
QUIT
+8 SET ^PS(52.41,G,"POE")=1
SET NOUN=$PIECE(DOSE("DD",IEN),"^",9)
SET VERB=$PIECE(DOSE("DD",IEN),"^",10)
+9 FOR E=0:0
SET E=$ORDER(^PS(52.41,G,1,E))
if 'E
QUIT
SET DUPD=$PIECE(^PS(52.41,G,1,E,0),"^")
SET DUPD=$PIECE(DUPD,"&")
Begin DoDot:2
+10 if $GET(RTE)]""
SET $PIECE(^PS(52.41,G,1,E,1),"^",8)=RTE
SET $PIECE(^PS(52.41,G,1,E,1),"^",5)=NOUN
SET $PIECE(^(1),"^",10)=VERB
+11 IF DUPD'?.N&(DUPD'?.N1".".N)
IF $PIECE($GET(^PS(52.41,G,1,E,2)),"^")']""
SET $PIECE(^PS(52.41,G,1,E,2),"^")=DUPD
QUIT
+12 IF DUPD
IF '$PIECE(DOSE("DD",IEN),"^",5)
IF $PIECE($GET(^PS(52.41,G,1,E,2)),"^")']""
Begin DoDot:3
+13 SET $PIECE(^PS(52.41,G,1,E,2),"^")=DUPD_" "_NOUN
+14 if $PIECE(DOSE("DD",IEN),"^",6)]""
SET UNITS=$ORDER(^PS(50.607,"B",$PIECE(DOSE("DD",IEN),"^",6),0))
+15 IF $GET(UNITS)
SET $PIECE(^PS(52.41,G,1,E,1),"^",9)=UNITS
End DoDot:3
QUIT
+16 if $PIECE($GET(^PS(52.41,G,1,E,2)),"^")']""
SET $PIECE(^PS(52.41,G,1,E,2),"^")=DUPD*$PIECE(DOSE("DD",IEN),"^",5)
+17 if $PIECE($GET(^PS(52.41,G,1,E,2)),"^",2)']""
SET $PIECE(^PS(52.41,G,1,E,2),"^",2)=DUPD
+18 if $PIECE(DOSE("DD",IEN),"^",6)]""
SET UNITS=$ORDER(^PS(50.607,"B",$PIECE(DOSE("DD",IEN),"^",6),0))
+19 IF $GET(UNITS)
SET $PIECE(^PS(52.41,G,1,E,1),"^",9)=UNITS
End DoDot:2
End DoDot:1
+20 KILL DOSE,I,F,G,IEN,RTE,DUPD,UNITS,NOUN,VERB,DD
+21 QUIT
POE FOR RXN=0:0
SET RXN=$ORDER(^PSRX(RXN))
if 'RXN
QUIT
IF $GET(^PSRX(RXN,0))]""
SET ^PSRX(RXN,"POE")=1
+1 KILL RXN
+2 QUIT
PSOMIS ;checks for unfinished orders without drugs PSO*7*74
+1 FOR I=0:0
SET I=$ORDER(^PS(52.41,"AOR",I))
if 'I
QUIT
FOR F=0:0
SET F=$ORDER(^PS(52.41,"AOR",I,F))
if 'F
QUIT
FOR G=0:0
SET G=$ORDER(^PS(52.41,"AOR",I,F,G))
if 'G
QUIT
Begin DoDot:1
+2 if $PIECE(^PS(52.41,G,0),"^",9)
QUIT
+3 IF $PIECE(^PS(52.41,G,0),"^",3)'="NW"
IF $PIECE(^(0),"^",3)'="RNW"
IF $PIECE(^(0),"^",3)'="RF"
KILL ^PS(52.41,"AOR",I,F,G)
QUIT
+4 FOR E=0:0
SET E=$ORDER(^PS(52.41,G,1,E))
if 'E
QUIT
SET $PIECE(^PS(52.41,G,1,E,1),"^",5)=""
End DoDot:1
+5 KILL G,I,E,F
+6 QUIT
