- 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 Feb 19, 2025@00:01:34 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