- 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
- 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
