PSOSPML8 ;WILM/BDB - State Prescription Monitoring Program Utilities ;10/07/12
;;7.0;OUTPATIENT PHARMACY;**625,630**;DEC 1997;Build 26
;
Q
;
ASK ;
N %DT,DIR,DIRUT,X,DIC,DTOUT,DUOUT,BEGDTTM,ENDDTTM,PSOERROR
N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
N RECTYPE,STATE,RTSONLY,LIST,PSOSPFLG,BATIEN,RXCNT
;
; - Selection of STATE
W ! S DIC("A")="STATE: ",DIC("S")="I $D(^PS(58.41,+Y,0))",DIC="^DIC(5,"
S DIC("B")=$$GET1^DIQ(5,+$O(^PS(58.41,0)),.01)
S DIC(0)="AEQMZ" D ^DIC I X="^"!(Y<0) Q
S STATE=+Y
BEGDT ;
; - Ask for Start DATE
S %DT(0)=3130211,%DT="AEP",%DT("A")="Begin Release Date: "
W ! D ^%DT I Y<0!($D(DTOUT)) Q
I (Y=DT)!(Y>DT) W !!?5,"Only past dates are allowed." D PAUSE^PSOSPMU1 G BEGDT
S BEGDTTM=Y
;
ENDDT ;
; - Ask for End DATE
K %DT S %DT(0)=BEGDTTM\1,%DT="AEP",%DT("B")="TODAY-1",%DT("A")="End Release Date: "
W ! D ^%DT I Y<0!($D(DTOUT)) Q
I (Y=DT)!(Y>DT) W !!?5,"The latest end date permitted is TODAY-1 (yesterday)." D PAUSE^PSOSPMU1 G ENDDT
S ENDDTTM=Y
S LIST="ARX"
S LIST("STATE")=STATE
S RECTYPE="N"
S RTSONLY=0
S RXCNT=$$GATHER^PSOSPMU1(STATE,BEGDTTM-.1,ENDDTTM+.24,RECTYPE,RTSONLY,.LIST)
I 'RXCNT W !!,"No Rx's Found" G END
D PRINT
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y"
S DIR("A")="Do you want to create a batch"
S DIR("B")="No"
D ^DIR
I Y D
. S BATIEN=$$BLDBAT^PSOSPMU1("MA",BEGDTTM,ENDDTTM)
. I $P(BATIEN,"^")=-1 W !!,$P(BATIEN,"^",2),! D LOGERROR^PSOSPMUT(0,STATE,$P(BATIEN,"^",2),1) Q
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
. S DIR(0)="Y"
. S DIR("A")="Do you want to launch Export Batch Processing"
. S DIR("B")="No"
. D ^DIR
. I Y D ^PSOSPML1
END K ^TMP("PSOSPMRX",$J)
Q
;
PRINT ; Allow queueing
S PSOJOB=$J
K ^XTMP("PSO70625",PSOJOB)
S ^XTMP("PSO70625",PSOJOB,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"SPMP NOT SENT SCRIPTS"
M ^XTMP("PSO70625",PSOJOB)=^TMP("PSOSPMRX",$J)
K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS
Q:POP
I $D(IO("Q")) D Q ;Queued report settings
.S ZTDESC="CS PRESCRIPTIONS NOT TRANSMITTED REPORT",ZTRTN="PSOQ^PSOSPML8"
.S ZTSAVE("PSOJOB")="",ZTSAVE("ZTREQ")="@"
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! K DIR S DIR(0)="E" D ^DIR K DIR
PSOQ ;
N PSOSPI,PSOSPJ,PSOSPK
S PSOSPI=0 S (PSOSPJ,PSOSPK)=""
W !!!,"CS Prescriptions Not Transmitted Report"
I '$G(PSOSPFLG) W !!,"Rx #",?15,"Fill #",?25,"Release Date",?45,"STATE"
F S PSOSPI=$O(^XTMP("PSO70625",PSOJOB,PSOSPI)) Q:PSOSPI="" D
.F S PSOSPJ=$O(^XTMP("PSO70625",PSOJOB,PSOSPI,PSOSPJ)) Q:PSOSPJ="" D
..F S PSOSPK=$O(^XTMP("PSO70625",PSOJOB,PSOSPI,PSOSPJ,PSOSPK)) Q:PSOSPK="" D
...W !,$$GET1^DIQ(52,PSOSPJ,.01),?15,PSOSPK,?25,$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(PSOSPJ,PSOSPK),2),?45,$$GET1^DIQ(5,$$RXSTATE^PSOBPSUT(PSOSPJ,0),.01) S PSOSPFLG=1
W !
K PSOJOB
Q
;
CHKST(RXIEN,FILL,STATE) ;check batch state
N BATCH,RSLT
S RSLT=0
S BATCH=0 F S BATCH=$O(^PS(58.42,"ARX",RXIEN,FILL,BATCH)) Q:BATCH="" D
.I STATE=$$GET1^DIQ(58.42,BATCH,1,"I") S RSLT=1
Q RSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPML8 3064 printed Sep 23, 2025@20:11:35 Page 2
PSOSPML8 ;WILM/BDB - State Prescription Monitoring Program Utilities ;10/07/12
+1 ;;7.0;OUTPATIENT PHARMACY;**625,630**;DEC 1997;Build 26
+2 ;
+3 QUIT
+4 ;
ASK ;
+1 NEW %DT,DIR,DIRUT,X,DIC,DTOUT,DUOUT,BEGDTTM,ENDDTTM,PSOERROR
+2 NEW POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
+3 NEW RECTYPE,STATE,RTSONLY,LIST,PSOSPFLG,BATIEN,RXCNT
+4 ;
+5 ; - Selection of STATE
+6 WRITE !
SET DIC("A")="STATE: "
SET DIC("S")="I $D(^PS(58.41,+Y,0))"
SET DIC="^DIC(5,"
+7 SET DIC("B")=$$GET1^DIQ(5,+$ORDER(^PS(58.41,0)),.01)
+8 SET DIC(0)="AEQMZ"
DO ^DIC
IF X="^"!(Y<0)
QUIT
+9 SET STATE=+Y
BEGDT ;
+1 ; - Ask for Start DATE
+2 SET %DT(0)=3130211
SET %DT="AEP"
SET %DT("A")="Begin Release Date: "
+3 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
QUIT
+4 IF (Y=DT)!(Y>DT)
WRITE !!?5,"Only past dates are allowed."
DO PAUSE^PSOSPMU1
GOTO BEGDT
+5 SET BEGDTTM=Y
+6 ;
ENDDT ;
+1 ; - Ask for End DATE
+2 KILL %DT
SET %DT(0)=BEGDTTM\1
SET %DT="AEP"
SET %DT("B")="TODAY-1"
SET %DT("A")="End Release Date: "
+3 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
QUIT
+4 IF (Y=DT)!(Y>DT)
WRITE !!?5,"The latest end date permitted is TODAY-1 (yesterday)."
DO PAUSE^PSOSPMU1
GOTO ENDDT
+5 SET ENDDTTM=Y
+6 SET LIST="ARX"
+7 SET LIST("STATE")=STATE
+8 SET RECTYPE="N"
+9 SET RTSONLY=0
+10 SET RXCNT=$$GATHER^PSOSPMU1(STATE,BEGDTTM-.1,ENDDTTM+.24,RECTYPE,RTSONLY,.LIST)
+11 IF 'RXCNT
WRITE !!,"No Rx's Found"
GOTO END
+12 DO PRINT
+13 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+14 SET DIR(0)="Y"
+15 SET DIR("A")="Do you want to create a batch"
+16 SET DIR("B")="No"
+17 DO ^DIR
+18 IF Y
Begin DoDot:1
+19 SET BATIEN=$$BLDBAT^PSOSPMU1("MA",BEGDTTM,ENDDTTM)
+20 IF $PIECE(BATIEN,"^")=-1
WRITE !!,$PIECE(BATIEN,"^",2),!
DO LOGERROR^PSOSPMUT(0,STATE,$PIECE(BATIEN,"^",2),1)
QUIT
+21 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+22 SET DIR(0)="Y"
+23 SET DIR("A")="Do you want to launch Export Batch Processing"
+24 SET DIR("B")="No"
+25 DO ^DIR
+26 IF Y
DO ^PSOSPML1
End DoDot:1
END KILL ^TMP("PSOSPMRX",$JOB)
+1 QUIT
+2 ;
PRINT ; Allow queueing
+1 SET PSOJOB=$JOB
+2 KILL ^XTMP("PSO70625",PSOJOB)
+3 SET ^XTMP("PSO70625",PSOJOB,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"SPMP NOT SENT SCRIPTS"
+4 MERGE ^XTMP("PSO70625",PSOJOB)=^TMP("PSOSPMRX",$JOB)
+5 KILL IOP,IO("Q")
SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
+6 if POP
QUIT
+7 ;Queued report settings
IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTDESC="CS PRESCRIPTIONS NOT TRANSMITTED REPORT"
SET ZTRTN="PSOQ^PSOSPML8"
+9 SET ZTSAVE("PSOJOB")=""
SET ZTSAVE("ZTREQ")="@"
+10 DO ^%ZTLOAD
DO HOME^%ZIS
+11 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
PSOQ ;
+1 NEW PSOSPI,PSOSPJ,PSOSPK
+2 SET PSOSPI=0
SET (PSOSPJ,PSOSPK)=""
+3 WRITE !!!,"CS Prescriptions Not Transmitted Report"
+4 IF '$GET(PSOSPFLG)
WRITE !!,"Rx #",?15,"Fill #",?25,"Release Date",?45,"STATE"
+5 FOR
SET PSOSPI=$ORDER(^XTMP("PSO70625",PSOJOB,PSOSPI))
if PSOSPI=""
QUIT
Begin DoDot:1
+6 FOR
SET PSOSPJ=$ORDER(^XTMP("PSO70625",PSOJOB,PSOSPI,PSOSPJ))
if PSOSPJ=""
QUIT
Begin DoDot:2
+7 FOR
SET PSOSPK=$ORDER(^XTMP("PSO70625",PSOJOB,PSOSPI,PSOSPJ,PSOSPK))
if PSOSPK=""
QUIT
Begin DoDot:3
+8 WRITE !,$$GET1^DIQ(52,PSOSPJ,.01),?15,PSOSPK,?25,$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(PSOSPJ,PSOSPK),2),?45,$$GET1^DIQ(5,$$RXSTATE^PSOBPSUT(PSOSPJ,0),.01)
SET PSOSPFLG=1
End DoDot:3
End DoDot:2
End DoDot:1
+9 WRITE !
+10 KILL PSOJOB
+11 QUIT
+12 ;
CHKST(RXIEN,FILL,STATE) ;check batch state
+1 NEW BATCH,RSLT
+2 SET RSLT=0
+3 SET BATCH=0
FOR
SET BATCH=$ORDER(^PS(58.42,"ARX",RXIEN,FILL,BATCH))
if BATCH=""
QUIT
Begin DoDot:1
+4 IF STATE=$$GET1^DIQ(58.42,BATCH,1,"I")
SET RSLT=1
End DoDot:1
+5 QUIT RSLT
