Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOSPML8

PSOSPML8.m

Go to the documentation of this file.
  1. PSOSPML8 ;WILM/BDB - State Prescription Monitoring Program Utilities ;10/07/12
  1. ;;7.0;OUTPATIENT PHARMACY;**625,630**;DEC 1997;Build 26
  1. ;
  1. Q
  1. ;
  1. ASK ;
  1. N %DT,DIR,DIRUT,X,DIC,DTOUT,DUOUT,BEGDTTM,ENDDTTM,PSOERROR
  1. N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
  1. N RECTYPE,STATE,RTSONLY,LIST,PSOSPFLG,BATIEN,RXCNT
  1. ;
  1. ; - Selection of STATE
  1. W ! S DIC("A")="STATE: ",DIC("S")="I $D(^PS(58.41,+Y,0))",DIC="^DIC(5,"
  1. S DIC("B")=$$GET1^DIQ(5,+$O(^PS(58.41,0)),.01)
  1. S DIC(0)="AEQMZ" D ^DIC I X="^"!(Y<0) Q
  1. S STATE=+Y
  1. BEGDT ;
  1. ; - Ask for Start DATE
  1. S %DT(0)=3130211,%DT="AEP",%DT("A")="Begin Release Date: "
  1. W ! D ^%DT I Y<0!($D(DTOUT)) Q
  1. I (Y=DT)!(Y>DT) W !!?5,"Only past dates are allowed." D PAUSE^PSOSPMU1 G BEGDT
  1. S BEGDTTM=Y
  1. ;
  1. ENDDT ;
  1. ; - Ask for End DATE
  1. K %DT S %DT(0)=BEGDTTM\1,%DT="AEP",%DT("B")="TODAY-1",%DT("A")="End Release Date: "
  1. W ! D ^%DT I Y<0!($D(DTOUT)) Q
  1. I (Y=DT)!(Y>DT) W !!?5,"The latest end date permitted is TODAY-1 (yesterday)." D PAUSE^PSOSPMU1 G ENDDT
  1. S ENDDTTM=Y
  1. S LIST="ARX"
  1. S LIST("STATE")=STATE
  1. S RECTYPE="N"
  1. S RTSONLY=0
  1. S RXCNT=$$GATHER^PSOSPMU1(STATE,BEGDTTM-.1,ENDDTTM+.24,RECTYPE,RTSONLY,.LIST)
  1. I 'RXCNT W !!,"No Rx's Found" G END
  1. D PRINT
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="Y"
  1. S DIR("A")="Do you want to create a batch"
  1. S DIR("B")="No"
  1. D ^DIR
  1. I Y D
  1. . S BATIEN=$$BLDBAT^PSOSPMU1("MA",BEGDTTM,ENDDTTM)
  1. . I $P(BATIEN,"^")=-1 W !!,$P(BATIEN,"^",2),! D LOGERROR^PSOSPMUT(0,STATE,$P(BATIEN,"^",2),1) Q
  1. . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. . S DIR(0)="Y"
  1. . S DIR("A")="Do you want to launch Export Batch Processing"
  1. . S DIR("B")="No"
  1. . D ^DIR
  1. . I Y D ^PSOSPML1
  1. END K ^TMP("PSOSPMRX",$J)
  1. Q
  1. ;
  1. PRINT ; Allow queueing
  1. S PSOJOB=$J
  1. K ^XTMP("PSO70625",PSOJOB)
  1. S ^XTMP("PSO70625",PSOJOB,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"SPMP NOT SENT SCRIPTS"
  1. M ^XTMP("PSO70625",PSOJOB)=^TMP("PSOSPMRX",$J)
  1. K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS
  1. Q:POP
  1. I $D(IO("Q")) D Q ;Queued report settings
  1. .S ZTDESC="CS PRESCRIPTIONS NOT TRANSMITTED REPORT",ZTRTN="PSOQ^PSOSPML8"
  1. .S ZTSAVE("PSOJOB")="",ZTSAVE("ZTREQ")="@"
  1. .D ^%ZTLOAD,HOME^%ZIS
  1. .I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! K DIR S DIR(0)="E" D ^DIR K DIR
  1. PSOQ ;
  1. N PSOSPI,PSOSPJ,PSOSPK
  1. S PSOSPI=0 S (PSOSPJ,PSOSPK)=""
  1. W !!!,"CS Prescriptions Not Transmitted Report"
  1. I '$G(PSOSPFLG) W !!,"Rx #",?15,"Fill #",?25,"Release Date",?45,"STATE"
  1. F S PSOSPI=$O(^XTMP("PSO70625",PSOJOB,PSOSPI)) Q:PSOSPI="" D
  1. .F S PSOSPJ=$O(^XTMP("PSO70625",PSOJOB,PSOSPI,PSOSPJ)) Q:PSOSPJ="" D
  1. ..F S PSOSPK=$O(^XTMP("PSO70625",PSOJOB,PSOSPI,PSOSPJ,PSOSPK)) Q:PSOSPK="" D
  1. ...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
  1. W !
  1. K PSOJOB
  1. Q
  1. ;
  1. CHKST(RXIEN,FILL,STATE) ;check batch state
  1. N BATCH,RSLT
  1. S RSLT=0
  1. S BATCH=0 F S BATCH=$O(^PS(58.42,"ARX",RXIEN,FILL,BATCH)) Q:BATCH="" D
  1. .I STATE=$$GET1^DIQ(58.42,BATCH,1,"I") S RSLT=1
  1. Q RSLT