PSOSPML0 ;BIRM/MFR - Scheduled Batch Export ;1/6/21 12:58
;;7.0;OUTPATIENT PHARMACY;**408,451,625,630,696,724**;DEC 1997;Build 3
;
AUTO ; SPMP Scheduled Background Job Edit
N DIC,Y S DIC(0)="XZM",DIC="^DIC(19.2,",X="PSO SPMP SCHEDULED EXPORT" D ^DIC
I +Y>0 S DA=Y D EDIT^XUTMOPT("PSO SPMP SCHEDULED EXPORT") Q
D RESCH^XUTMOPT("PSO SPMP SCHEDULED EXPORT",$$FMADD^XLFDT(DT,1)+.0001,"","24H","L")
D EDIT^XUTMOPT("PSO SPMP SCHEDULED EXPORT")
Q
;
EXPORT ; SPMP Nightly Scheduled Export
N STATE,NODE0,EXPNODE,BEGEXPDT,FREQCY,YESTERDY,BATIEN,RXCNT,RTSBGDT,RTSENDT
;
D CHK5841
K ^TMP("PSOSPMBM",$J) ;P696
S STATE=0
F S STATE=$O(^PS(58.41,STATE)) Q:'STATE D
. K ^TMP("PSOSPMRX",$J)
. I $P($$SPOK^PSOSPMUT(STATE),"^")=-1 D Q
. . D LOGERROR^PSOSPMUT(0,STATE,$P($$SPOK^PSOSPMUT(STATE),"^",2),1)
. S ^TMP("PSOSPMBM",$J,STATE)=0 ;P696
. S NODE0=$G(^PS(58.41,STATE,0)),EXPNODE=$G(^PS(58.41,STATE,"EXPORT"))
. S FREQCY=$P(NODE0,"^",4),YESTERDY=$$FMADD^XLFDT(DT,-1)
. S BEGEXPDT=$$FMADD^XLFDT(DT,-FREQCY)
. I $P(EXPNODE,"^") S BEGEXPDT=$$FMADD^XLFDT($P(EXPNODE,"^"),+1)
. ; Cannot run for current day because it will skip Rx's w/ RELEASE DATE/TIME w/out time
. I BEGEXPDT>YESTERDY Q
. ; Checking if it is time to transmit based on the TRANSMISSION FREQUENCY value
. I $$FMADD^XLFDT(BEGEXPDT,FREQCY)>DT Q
. ; Preventing a Scheduled Transmission Date Range of more than 30 days - Reset to Frequency
. I $$FMDIFF^XLFDT(YESTERDY,BEGEXPDT)>30 S BEGEXPDT=$$FMADD^XLFDT(YESTERDY,-FREQCY)
. ; The legislation allowing VA to report was published on 02/11/2013
. I BEGEXPDT<3130211 S BEGEXPDT=3130211
. ; Gathering the prescriptions to be transmitted in the ^TMP("PSOSPMRX",$J) global
. S RXCNT=$$GATHER^PSOSPMU1(STATE,BEGEXPDT-.1,YESTERDY+.24,"N")
. ; The ^TMP("PSOSPMRX",$J) returned will be used to build the batch
. I RXCNT>0 D
. . S ^TMP("PSOSPMBM",$J,STATE)=1 ;P696
. . S BATIEN=$$BLDBAT^PSOSPMU1("SC",BEGEXPDT,YESTERDY)
. . I $P(BATIEN,"^")=-1 D LOGERROR^PSOSPMUT(0,STATE,$P(BATIEN,"^",2),1) Q
. . ; Automatic sFTP Transmission to the state
. . I $$GET1^DIQ(58.41,STATE,13,"I")="A" D
. . . D EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
. . ; Manual sFTP Transmission to the state
. . I $$GET1^DIQ(58.41,STATE,13,"I")="M" D
. . . D SENDMAIL(BATIEN,"S")
. ;Zero Report - Daily Separate File
. N SITEIEN S SITEIEN=0
. N DEANO S DEANO=""
. K ^TMP("PSOSPZRP",$J),DEARX,DEANRX,SITES,ZDEA
. I $$GET1^DIQ(58.41,STATE,21,"I")'=2 D ;P696
. . F S SITEIEN=$O(^PS(59,SITEIEN)) Q:'SITEIEN D
. . . Q:$$GET1^DIQ(59,SITEIEN,.08,"I")'=STATE
. . . I $$GET1^DIQ(59,SITEIEN,2004,"I")'="",$$GET1^DIQ(59,SITEIEN,2004,"I")<DT Q
. . . S DEANO=$$PHA03^PSOASAP0() I DEANO="" Q
. . . S SITES(SITEIEN)=DEANO
. . . I $D(^TMP("PSOSPMST",$J,SITEIEN)),'$G(DEARX(DEANO)) S DEARX(DEANO)=SITEIEN
. . . E S DEANRX(DEANO)=SITEIEN
. . N DEA,SITE
. . S (DEA,SITE)=""
. . F S DEA=$O(DEANRX(DEA)) Q:DEA="" D
. . . I '$G(DEARX(DEA)) S SITE=DEANRX(DEA) S ZDEA(DEA)=SITE S ^TMP("PSOSPZRP",$J,SITE)=DEA
. . I $D(^TMP("PSOSPZRP",$J)) D
. . . I $$GET1^DIQ(58.41,STATE,20)'="" D ;Sites with no RX and Yes to send Zero Report
. . . . N %,DIC,DR,DA,X,Y,DINUM,DLAYGO,DD,DO,EXPTYPE
. . . . S EXPTYPE="ZR"
. . . . F L +^PS(58.42,0):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) Q:$T H 3
. . . . S (DINUM,BATIEN)=$O(^PS(58.42,999999999999),-1)+1
. . . . W !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
. . . . S DIC="^PS(58.42,",X=DINUM,DIC(0)="",DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()
. . . . S DIC("DR")=DIC("DR")_";4///"_$G(BEGEXPDT)_";5///"_$G(YESTERDY)
. . . . S DLAYGO=58.42 K DD,DO D FILE^DICN K DD,DO
. . . . L -^PS(58.42,0)
. . . . I Y=-1 S BATIEN="-1^Export Batch could not be created" Q
. . . . N SITE,DEAZ S SITE=""
. . . . F S SITE=$O(SITES(SITE)) Q:SITE="" D
. . . . . S DEAZ=$G(SITES(SITE)) I '$G(ZDEA(DEAZ)) Q
. . . . . K DIC,DINUM,DA S DIC="^PS(58.42,"_BATIEN_",""ZRS"",",DIC(0)="",DA(1)=BATIEN
. . . . . S X=SITE,DIC("DR")="1///"_DEAZ
. . . . . S DLAYGO=58.42201 K DD,DO D FILE^DICN K DD,DO
. . . . ; Automatic sFTP Transmission to the state
. . . . D EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
. . . . N SITE S SITE=0
. . . . N DEA S DEA=""
. . . . F S SITE=$O(^TMP("PSOSPZRP",$J,SITE)) Q:'SITE D
. . . . . S DEA=$G(^TMP("PSOSPZRP",$J,SITE))
. . . . . D SENDMAIL(BATIEN,"ZY",DEA)
. . . E D SENDMAIL("","ZN")
. K DIE,DR,DA S DR="11///"_YESTERDY S DIE="^PS(58.41,",DA=STATE D ^DIE
. ;RX Not Transmitted Report - Daily Separate File
. N BEGEXPDT,YESTERDY,BATIEN,RXCNT,LIST
. K ^TMP("PSOSPMRX",$J)
. S BEGEXPDT=$$FMADD^XLFDT(DT,-30)
. S YESTERDY=$$FMADD^XLFDT(DT,-1)
. S LIST="ARX"
. S LIST("STATE")=STATE
. ; Gathering the prescriptions to be transmitted in the ^TMP("PSOSPMRX",$J) global
. S RXCNT=$$GATHER^PSOSPMU1(STATE,BEGEXPDT-.1,YESTERDY+.24,"N",0,.LIST)
. I RXCNT>0 D
. . S BATIEN=$$BLDBAT^PSOSPMU1("SC",BEGEXPDT,YESTERDY)
. . I $P(BATIEN,"^")=-1 D LOGERROR^PSOSPMUT(0,STATE,$P(BATIEN,"^",2),1) Q
. .; Automatic sFTP Transmission to the state
. . I $$GET1^DIQ(58.41,STATE,13,"I")="A" D
. . . D EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
. .; Manual sFTP Transmission to the state
. . I $$GET1^DIQ(58.41,STATE,13,"I")="M" D
. . . D SENDMAIL^PSOSPML0(BATIEN,"S")
;P696 Loop thru temp global for MbM states that need a Zero Report
S STATE=0
F S STATE=$O(^TMP("PSOSPMBM",$J,STATE)) Q:'STATE D
. N MBMST
. S MBMST=$$GET1^DIQ(58.41,STATE,21,"I")
. I (+MBMST=2),($G(^TMP("PSOSPMBM",$J,STATE))'=1) D
. . I $$GET1^DIQ(58.41,STATE,20)'="" D ;State wants a zero report, and there were no RXs
. . . ;get default outpat site and DEA#
. . . N SITEIEN,DEANO S (SITEIEN,DEANO)=""
. . . S SITEIEN=$$GET1^DIQ(58.41,STATE,22,"I")
. . . S DEANO=$$PHA03^PSOASAP0() I DEANO="" Q
. . . ;logic from BLDBAT
. . . N %,DIC,DR,DA,X,Y,DINUM,DLAYGO,DD,DO,EXPTYPE
. . . S EXPTYPE="ZR"
. . . F L +^PS(58.42,0):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) Q:$T H 3
. . . S (DINUM,BATIEN)=$O(^PS(58.42,999999999999),-1)+1
. . . W !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
. . . S DIC="^PS(58.42,",X=DINUM,DIC(0)="",DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()
. . . S DIC("DR")=DIC("DR")_";4///"_$G(BEGEXPDT)_";5///"_$G(YESTERDY)
. . . S DLAYGO=58.42 K DD,DO D FILE^DICN K DD,DO
. . . L -^PS(58.42,0)
. . . I Y=-1 S BATIEN="-1^Export Batch could not be created" Q
. . . K DIC,DINUM,DA S DIC="^PS(58.42,"_BATIEN_",""ZRS"",",DIC(0)="",DA(1)=BATIEN
. . . S X=SITEIEN,DIC("DR")="1///"_DEANO
. . . S DLAYGO=58.42201 K DD,DO D FILE^DICN K DD,DO
. . . ; Automatic sFTP Transmission to the state
. . . D EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
. . . D SENDMAIL(BATIEN,"ZY",DEANO)
. . E D SENDMAIL("","ZN")
; Return To Stock Batch for ASAP 1995 states only (Weekly) - Separate file
I $$UP^XLFSTR($$DOW^XLFDT(DT))'="SUNDAY" Q
S STATE=0 F S STATE=$O(^PS(58.41,STATE)) Q:'STATE D
. ; State not using ASAP 1995
. I $$GET1^DIQ(58.41,STATE,1,"I")'="1995" Q
. ; State accepts Return to Stock transmissions
. S RTSBGDT=$$FMADD^XLFDT(DT,-7),RTSENDT=$$FMADD^XLFDT(DT,-1)
. S RXCNT=$$GATHER^PSOSPMU1(STATE,RTSBGDT-.1,RTSENDT+.24,"N",1) I RXCNT'>0 Q
. S BATIEN=$$BLDBAT^PSOSPMU1("VD",RTSBGDT,RTSENDT)
. I $$GET1^DIQ(58.41,STATE,12,"I") D
. . D EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
. E D SENDMAIL(BATIEN,"R")
Q
;
SENDMAIL(BATCHIEN,BATTYPE,DEA) ; ASAP 1995 Only - Mailman message about Return To Stock Records
;Input: BATCHIEN - Pointer to BATCH file (#58.42)
; BATTYPE - Batch Type: S: Scheduled / R: Return to Stock (ASAP 1995 only)
; ZN: No Zero Report email only / ZY: Yes Zero Report and email
; (O) DEA - DEA Numbers passed in for Zero Report
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PSOMSG,USR,STANAME
N RUNDT ;Zero Reporting
;
S STANAME=$$GET1^DIQ(58.42,BATCHIEN,1)
I $G(STANAME)="" S STANAME=$$GET1^DIQ(58.41,STATE,.01) ;Zero Report
; - Scheduled Batch Notification
I (BATTYPE="S") D
. S XMSUB=STANAME_" CS PMP Batch Ready"
. S XMSUB=XMSUB_" ("_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")
. S XMSUB=XMSUB_"-"_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z")_")"
. S PSOMSG(1)="Batch #: "_BATCHIEN_" Period : "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")_" thru "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z")
. S PSOMSG(2)=""
. S PSOMSG(3)="The scheduled batch #"_BATCHIEN_" containing Controlled Substance Prescription data"
. S PSOMSG(4)="to be submitted to the Prescription Monitoring Program (PMP) for the state of "
. S PSOMSG(5)=STANAME_" is ready."
. S PSOMSG(6)=""
. S PSOMSG(7)="Please use the option ""View/Export Batch"" [PSO SPMP BATCH VIEW/EXPORT], then"
. S PSOMSG(8)="enter the batch #"_BATCHIEN_", choose the action 'EXP' and follow the instructions"
. S PSOMSG(9)="to send the file to the state."
;
; - Return To Stock Batch Notification (ASAP 1995 only)
I (BATTYPE="R") D
. S XMSUB=STANAME_" - CS Rx Fills Returned To Stock"
. S XMDUZ="SPMP Scheduled Transmission"
. S PSOMSG(1)="There were Controlled Substance Rx fills that had been reported to the State"
. S PSOMSG(2)="Prescription Monitoring Program (SPMP) and were later returned to stock:"
. S PSOMSG(3)=""
. S PSOMSG(4)="Batch #: "_BATCHIEN_" Period : "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")_" thru "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z")
. S PSOMSG(6)=""
. S PSOMSG(7)="Please, retrieve the batch above via the View/Export Batch [PSO SPMP BATCH"
. S PSOMSG(8)="VIEW/EXPORT] option and manually capture/upload the data to the State"
. S PSOMSG(9)="Prescription Monitoring Program (SPMP) website for "_STANAME_"."
. S PSOMSG(10)=""
. S PSOMSG(11)="***************************** IMPORTANT **********************************"
. S PSOMSG(12)="When you upload this file to the state website, make sure to select the"
. S PSOMSG(13)="correct import option, usually called ""Back Records Out of the System"", to"
. S PSOMSG(14)="avoid reporting duplicate records for the patients."
. S PSOMSG(15)="**************************************************************************"
;
;Zero Report Sent
I (BATTYPE="ZY") D
. S XMSUB=STANAME_" SPMP Controlled Substance Zero Report: "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"5Z")
. S PSOMSG(1)="No prescriptions met the submission criteria for Pharmacies using DEA#"_DEA
. S PSOMSG(2)="A Zero Report has been created for transmission to the state."
;
;Zero Report NOT Sent
I (BATTYPE="ZN") D
. N XDT S XDT=$$FMADD^XLFDT((DT\1),-1)
. S XMSUB=STANAME_" SPMP Controlled Substance Zero Report: "_$$FMTE^XLFDT((XDT\1),"5Z")
. S PSOMSG(1)="No prescriptions met the submission criteria. "
. S PSOMSG(2)="Follow your state's guidance for manual upload of a Zero Report, if required."
;
GROUP ;
S XMTEXT="PSOMSG("
; If there are no active members in the mailgroup sends message to PSDMGR key holders
I $$GOTLOCAL^XMXAPIG("PSO SPMP NOTIFICATIONS") D
. S XMY("G.PSO SPMP NOTIFICATIONS")=""
E D
. S USR=0 F S USR=$O(^XUSEC("PSDMGR",USR)) Q:'USR S XMY(USR)=""
;
D ^XMD
Q
CHK5841 ; Check the SPMP STATE PARAMETERS file (#58.41) for presence of state transmission info
N SITEIEN,SITE,STATEIEN,STATE,FOUND,XREF,RXDT,ENDDT,RXIEN,RXFILL,FILL
K ^TMP("PSO5841",$J)
S SITEIEN=0
F S SITEIEN=$O(^PS(59,SITEIEN)) Q:'SITEIEN D
. S STATEIEN=$$GET1^DIQ(59,SITEIEN,.08,"I")
. I 'STATEIEN Q
. I $P($$SPOK^PSOSPMUT(STATEIEN),"^")=-1 D
.. S FOUND=0
.. F XREF="AL","AM" D
... S RXDT=$$FMADD^XLFDT(DT,-365),RXDT=RXDT+.01,ENDDT=$$FMADD^XLFDT(DT,-1),ENDDT=ENDDT+.2359
... F S RXDT=$O(^PSRX(XREF,RXDT)) Q:'RXDT!(RXDT>ENDDT) D
.... S RXIEN=0 F S RXIEN=$O(^PSRX(XREF,RXDT,RXIEN)) Q:'RXIEN Q:FOUND D
..... S RXFILL="" F S RXFILL=$O(^PSRX(XREF,RXDT,RXIEN,RXFILL)) Q:RXFILL="" D
...... S FILL=$S(XREF="AL":RXFILL,1:"P"_RXFILL)
...... I $$RXSTATE^PSOBPSUT(RXIEN,0)'=STATEIEN Q
...... I $$SCREEN^PSOSPMUT(RXIEN,FILL) Q
...... S ^TMP("PSO5841",$J,SITEIEN)="Controlled Substance Rx found, but transmission info is missing for "_$$GET1^DIQ(59,SITEIEN,.08)_" in the SPMP STATE PARAMETERS file (#58.41)."
...... S FOUND=1
I $D(^TMP("PSO5841",$J)) D
. S SITEIEN=0
. F S SITEIEN=$O(^TMP("PSO5841",$J,SITEIEN)) Q:'SITEIEN D
.. S SITE=$$GET1^DIQ(59,SITEIEN,.01)
.. S STATE=$$GET1^DIQ(59,SITEIEN,.08)
.. S XMSUB=SITE_" Controlled Substances PMP State Parameters Missing"
.. S PSOMSG(1)=SITE_" doesn't currently transmit controlled substance records"
.. S PSOMSG(2)="because it is in a state ("_STATE_") that doesn't have SPMP"
.. S PSOMSG(3)="state parameters defined in your VistA system. Please enter a helpdesk"
.. S PSOMSG(4)="ticket if you need assistance setting up SPMP state parameters for"
.. S PSOMSG(5)=STATE_"."
.. D GROUP
. K ^TMP("PSO5841",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPML0 13056 printed Oct 16, 2024@18:35:39 Page 2
PSOSPML0 ;BIRM/MFR - Scheduled Batch Export ;1/6/21 12:58
+1 ;;7.0;OUTPATIENT PHARMACY;**408,451,625,630,696,724**;DEC 1997;Build 3
+2 ;
AUTO ; SPMP Scheduled Background Job Edit
+1 NEW DIC,Y
SET DIC(0)="XZM"
SET DIC="^DIC(19.2,"
SET X="PSO SPMP SCHEDULED EXPORT"
DO ^DIC
+2 IF +Y>0
SET DA=Y
DO EDIT^XUTMOPT("PSO SPMP SCHEDULED EXPORT")
QUIT
+3 DO RESCH^XUTMOPT("PSO SPMP SCHEDULED EXPORT",$$FMADD^XLFDT(DT,1)+.0001,"","24H","L")
+4 DO EDIT^XUTMOPT("PSO SPMP SCHEDULED EXPORT")
+5 QUIT
+6 ;
EXPORT ; SPMP Nightly Scheduled Export
+1 NEW STATE,NODE0,EXPNODE,BEGEXPDT,FREQCY,YESTERDY,BATIEN,RXCNT,RTSBGDT,RTSENDT
+2 ;
+3 DO CHK5841
+4 ;P696
KILL ^TMP("PSOSPMBM",$JOB)
+5 SET STATE=0
+6 FOR
SET STATE=$ORDER(^PS(58.41,STATE))
if 'STATE
QUIT
Begin DoDot:1
+7 KILL ^TMP("PSOSPMRX",$JOB)
+8 IF $PIECE($$SPOK^PSOSPMUT(STATE),"^")=-1
Begin DoDot:2
+9 DO LOGERROR^PSOSPMUT(0,STATE,$PIECE($$SPOK^PSOSPMUT(STATE),"^",2),1)
End DoDot:2
QUIT
+10 ;P696
SET ^TMP("PSOSPMBM",$JOB,STATE)=0
+11 SET NODE0=$GET(^PS(58.41,STATE,0))
SET EXPNODE=$GET(^PS(58.41,STATE,"EXPORT"))
+12 SET FREQCY=$PIECE(NODE0,"^",4)
SET YESTERDY=$$FMADD^XLFDT(DT,-1)
+13 SET BEGEXPDT=$$FMADD^XLFDT(DT,-FREQCY)
+14 IF $PIECE(EXPNODE,"^")
SET BEGEXPDT=$$FMADD^XLFDT($PIECE(EXPNODE,"^"),+1)
+15 ; Cannot run for current day because it will skip Rx's w/ RELEASE DATE/TIME w/out time
+16 IF BEGEXPDT>YESTERDY
QUIT
+17 ; Checking if it is time to transmit based on the TRANSMISSION FREQUENCY value
+18 IF $$FMADD^XLFDT(BEGEXPDT,FREQCY)>DT
QUIT
+19 ; Preventing a Scheduled Transmission Date Range of more than 30 days - Reset to Frequency
+20 IF $$FMDIFF^XLFDT(YESTERDY,BEGEXPDT)>30
SET BEGEXPDT=$$FMADD^XLFDT(YESTERDY,-FREQCY)
+21 ; The legislation allowing VA to report was published on 02/11/2013
+22 IF BEGEXPDT<3130211
SET BEGEXPDT=3130211
+23 ; Gathering the prescriptions to be transmitted in the ^TMP("PSOSPMRX",$J) global
+24 SET RXCNT=$$GATHER^PSOSPMU1(STATE,BEGEXPDT-.1,YESTERDY+.24,"N")
+25 ; The ^TMP("PSOSPMRX",$J) returned will be used to build the batch
+26 IF RXCNT>0
Begin DoDot:2
+27 ;P696
SET ^TMP("PSOSPMBM",$JOB,STATE)=1
+28 SET BATIEN=$$BLDBAT^PSOSPMU1("SC",BEGEXPDT,YESTERDY)
+29 IF $PIECE(BATIEN,"^")=-1
DO LOGERROR^PSOSPMUT(0,STATE,$PIECE(BATIEN,"^",2),1)
QUIT
+30 ; Automatic sFTP Transmission to the state
+31 IF $$GET1^DIQ(58.41,STATE,13,"I")="A"
Begin DoDot:3
+32 DO EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
End DoDot:3
+33 ; Manual sFTP Transmission to the state
+34 IF $$GET1^DIQ(58.41,STATE,13,"I")="M"
Begin DoDot:3
+35 DO SENDMAIL(BATIEN,"S")
End DoDot:3
End DoDot:2
+36 ;Zero Report - Daily Separate File
+37 NEW SITEIEN
SET SITEIEN=0
+38 NEW DEANO
SET DEANO=""
+39 KILL ^TMP("PSOSPZRP",$JOB),DEARX,DEANRX,SITES,ZDEA
+40 ;P696
IF $$GET1^DIQ(58.41,STATE,21,"I")'=2
Begin DoDot:2
+41 FOR
SET SITEIEN=$ORDER(^PS(59,SITEIEN))
if 'SITEIEN
QUIT
Begin DoDot:3
+42 if $$GET1^DIQ(59,SITEIEN,.08,"I")'=STATE
QUIT
+43 IF $$GET1^DIQ(59,SITEIEN,2004,"I")'=""
IF $$GET1^DIQ(59,SITEIEN,2004,"I")<DT
QUIT
+44 SET DEANO=$$PHA03^PSOASAP0()
IF DEANO=""
QUIT
+45 SET SITES(SITEIEN)=DEANO
+46 IF $DATA(^TMP("PSOSPMST",$JOB,SITEIEN))
IF '$GET(DEARX(DEANO))
SET DEARX(DEANO)=SITEIEN
+47 IF '$TEST
SET DEANRX(DEANO)=SITEIEN
End DoDot:3
+48 NEW DEA,SITE
+49 SET (DEA,SITE)=""
+50 FOR
SET DEA=$ORDER(DEANRX(DEA))
if DEA=""
QUIT
Begin DoDot:3
+51 IF '$GET(DEARX(DEA))
SET SITE=DEANRX(DEA)
SET ZDEA(DEA)=SITE
SET ^TMP("PSOSPZRP",$JOB,SITE)=DEA
End DoDot:3
+52 IF $DATA(^TMP("PSOSPZRP",$JOB))
Begin DoDot:3
+53 ;Sites with no RX and Yes to send Zero Report
IF $$GET1^DIQ(58.41,STATE,20)'=""
Begin DoDot:4
+54 NEW %,DIC,DR,DA,X,Y,DINUM,DLAYGO,DD,DO,EXPTYPE
+55 SET EXPTYPE="ZR"
+56 FOR
LOCK +^PS(58.42,0):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
if $TEST
QUIT
HANG 3
+57 SET (DINUM,BATIEN)=$ORDER(^PS(58.42,999999999999),-1)+1
+58 WRITE !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
+59 SET DIC="^PS(58.42,"
SET X=DINUM
SET DIC(0)=""
SET DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()
+60 SET DIC("DR")=DIC("DR")_";4///"_$GET(BEGEXPDT)_";5///"_$GET(YESTERDY)
+61 SET DLAYGO=58.42
KILL DD,DO
DO FILE^DICN
KILL DD,DO
+62 LOCK -^PS(58.42,0)
+63 IF Y=-1
SET BATIEN="-1^Export Batch could not be created"
QUIT
+64 NEW SITE,DEAZ
SET SITE=""
+65 FOR
SET SITE=$ORDER(SITES(SITE))
if SITE=""
QUIT
Begin DoDot:5
+66 SET DEAZ=$GET(SITES(SITE))
IF '$GET(ZDEA(DEAZ))
QUIT
+67 KILL DIC,DINUM,DA
SET DIC="^PS(58.42,"_BATIEN_",""ZRS"","
SET DIC(0)=""
SET DA(1)=BATIEN
+68 SET X=SITE
SET DIC("DR")="1///"_DEAZ
+69 SET DLAYGO=58.42201
KILL DD,DO
DO FILE^DICN
KILL DD,DO
End DoDot:5
+70 ; Automatic sFTP Transmission to the state
+71 DO EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
+72 NEW SITE
SET SITE=0
+73 NEW DEA
SET DEA=""
+74 FOR
SET SITE=$ORDER(^TMP("PSOSPZRP",$JOB,SITE))
if 'SITE
QUIT
Begin DoDot:5
+75 SET DEA=$GET(^TMP("PSOSPZRP",$JOB,SITE))
+76 DO SENDMAIL(BATIEN,"ZY",DEA)
End DoDot:5
End DoDot:4
+77 IF '$TEST
DO SENDMAIL("","ZN")
End DoDot:3
End DoDot:2
+78 KILL DIE,DR,DA
SET DR="11///"_YESTERDY
SET DIE="^PS(58.41,"
SET DA=STATE
DO ^DIE
+79 ;RX Not Transmitted Report - Daily Separate File
+80 NEW BEGEXPDT,YESTERDY,BATIEN,RXCNT,LIST
+81 KILL ^TMP("PSOSPMRX",$JOB)
+82 SET BEGEXPDT=$$FMADD^XLFDT(DT,-30)
+83 SET YESTERDY=$$FMADD^XLFDT(DT,-1)
+84 SET LIST="ARX"
+85 SET LIST("STATE")=STATE
+86 ; Gathering the prescriptions to be transmitted in the ^TMP("PSOSPMRX",$J) global
+87 SET RXCNT=$$GATHER^PSOSPMU1(STATE,BEGEXPDT-.1,YESTERDY+.24,"N",0,.LIST)
+88 IF RXCNT>0
Begin DoDot:2
+89 SET BATIEN=$$BLDBAT^PSOSPMU1("SC",BEGEXPDT,YESTERDY)
+90 IF $PIECE(BATIEN,"^")=-1
DO LOGERROR^PSOSPMUT(0,STATE,$PIECE(BATIEN,"^",2),1)
QUIT
+91 ; Automatic sFTP Transmission to the state
+92 IF $$GET1^DIQ(58.41,STATE,13,"I")="A"
Begin DoDot:3
+93 DO EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
End DoDot:3
+94 ; Manual sFTP Transmission to the state
+95 IF $$GET1^DIQ(58.41,STATE,13,"I")="M"
Begin DoDot:3
+96 DO SENDMAIL^PSOSPML0(BATIEN,"S")
End DoDot:3
End DoDot:2
End DoDot:1
+97 ;P696 Loop thru temp global for MbM states that need a Zero Report
+98 SET STATE=0
+99 FOR
SET STATE=$ORDER(^TMP("PSOSPMBM",$JOB,STATE))
if 'STATE
QUIT
Begin DoDot:1
+100 NEW MBMST
+101 SET MBMST=$$GET1^DIQ(58.41,STATE,21,"I")
+102 IF (+MBMST=2)
IF ($GET(^TMP("PSOSPMBM",$JOB,STATE))'=1)
Begin DoDot:2
+103 ;State wants a zero report, and there were no RXs
IF $$GET1^DIQ(58.41,STATE,20)'=""
Begin DoDot:3
+104 ;get default outpat site and DEA#
+105 NEW SITEIEN,DEANO
SET (SITEIEN,DEANO)=""
+106 SET SITEIEN=$$GET1^DIQ(58.41,STATE,22,"I")
+107 SET DEANO=$$PHA03^PSOASAP0()
IF DEANO=""
QUIT
+108 ;logic from BLDBAT
+109 NEW %,DIC,DR,DA,X,Y,DINUM,DLAYGO,DD,DO,EXPTYPE
+110 SET EXPTYPE="ZR"
+111 FOR
LOCK +^PS(58.42,0):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
if $TEST
QUIT
HANG 3
+112 SET (DINUM,BATIEN)=$ORDER(^PS(58.42,999999999999),-1)+1
+113 WRITE !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
+114 SET DIC="^PS(58.42,"
SET X=DINUM
SET DIC(0)=""
SET DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()
+115 SET DIC("DR")=DIC("DR")_";4///"_$GET(BEGEXPDT)_";5///"_$GET(YESTERDY)
+116 SET DLAYGO=58.42
KILL DD,DO
DO FILE^DICN
KILL DD,DO
+117 LOCK -^PS(58.42,0)
+118 IF Y=-1
SET BATIEN="-1^Export Batch could not be created"
QUIT
+119 KILL DIC,DINUM,DA
SET DIC="^PS(58.42,"_BATIEN_",""ZRS"","
SET DIC(0)=""
SET DA(1)=BATIEN
+120 SET X=SITEIEN
SET DIC("DR")="1///"_DEANO
+121 SET DLAYGO=58.42201
KILL DD,DO
DO FILE^DICN
KILL DD,DO
+122 ; Automatic sFTP Transmission to the state
+123 DO EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
+124 DO SENDMAIL(BATIEN,"ZY",DEANO)
End DoDot:3
+125 IF '$TEST
DO SENDMAIL("","ZN")
End DoDot:2
End DoDot:1
+126 ; Return To Stock Batch for ASAP 1995 states only (Weekly) - Separate file
+127 IF $$UP^XLFSTR($$DOW^XLFDT(DT))'="SUNDAY"
QUIT
+128 SET STATE=0
FOR
SET STATE=$ORDER(^PS(58.41,STATE))
if 'STATE
QUIT
Begin DoDot:1
+129 ; State not using ASAP 1995
+130 IF $$GET1^DIQ(58.41,STATE,1,"I")'="1995"
QUIT
+131 ; State accepts Return to Stock transmissions
+132 SET RTSBGDT=$$FMADD^XLFDT(DT,-7)
SET RTSENDT=$$FMADD^XLFDT(DT,-1)
+133 SET RXCNT=$$GATHER^PSOSPMU1(STATE,RTSBGDT-.1,RTSENDT+.24,"N",1)
IF RXCNT'>0
QUIT
+134 SET BATIEN=$$BLDBAT^PSOSPMU1("VD",RTSBGDT,RTSENDT)
+135 IF $$GET1^DIQ(58.41,STATE,12,"I")
Begin DoDot:2
+136 DO EXPORT^PSOSPMUT(BATIEN,"EXPORT",1)
End DoDot:2
+137 IF '$TEST
DO SENDMAIL(BATIEN,"R")
End DoDot:1
+138 QUIT
+139 ;
SENDMAIL(BATCHIEN,BATTYPE,DEA) ; ASAP 1995 Only - Mailman message about Return To Stock Records
+1 ;Input: BATCHIEN - Pointer to BATCH file (#58.42)
+2 ; BATTYPE - Batch Type: S: Scheduled / R: Return to Stock (ASAP 1995 only)
+3 ; ZN: No Zero Report email only / ZY: Yes Zero Report and email
+4 ; (O) DEA - DEA Numbers passed in for Zero Report
+5 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PSOMSG,USR,STANAME
+6 ;Zero Reporting
NEW RUNDT
+7 ;
+8 SET STANAME=$$GET1^DIQ(58.42,BATCHIEN,1)
+9 ;Zero Report
IF $GET(STANAME)=""
SET STANAME=$$GET1^DIQ(58.41,STATE,.01)
+10 ; - Scheduled Batch Notification
+11 IF (BATTYPE="S")
Begin DoDot:1
+12 SET XMSUB=STANAME_" CS PMP Batch Ready"
+13 SET XMSUB=XMSUB_" ("_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")
+14 SET XMSUB=XMSUB_"-"_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z")_")"
+15 SET PSOMSG(1)="Batch #: "_BATCHIEN_" Period : "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")_" thru "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z")
+16 SET PSOMSG(2)=""
+17 SET PSOMSG(3)="The scheduled batch #"_BATCHIEN_" containing Controlled Substance Prescription data"
+18 SET PSOMSG(4)="to be submitted to the Prescription Monitoring Program (PMP) for the state of "
+19 SET PSOMSG(5)=STANAME_" is ready."
+20 SET PSOMSG(6)=""
+21 SET PSOMSG(7)="Please use the option ""View/Export Batch"" [PSO SPMP BATCH VIEW/EXPORT], then"
+22 SET PSOMSG(8)="enter the batch #"_BATCHIEN_", choose the action 'EXP' and follow the instructions"
+23 SET PSOMSG(9)="to send the file to the state."
End DoDot:1
+24 ;
+25 ; - Return To Stock Batch Notification (ASAP 1995 only)
+26 IF (BATTYPE="R")
Begin DoDot:1
+27 SET XMSUB=STANAME_" - CS Rx Fills Returned To Stock"
+28 SET XMDUZ="SPMP Scheduled Transmission"
+29 SET PSOMSG(1)="There were Controlled Substance Rx fills that had been reported to the State"
+30 SET PSOMSG(2)="Prescription Monitoring Program (SPMP) and were later returned to stock:"
+31 SET PSOMSG(3)=""
+32 SET PSOMSG(4)="Batch #: "_BATCHIEN_" Period : "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")_" thru "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z")
+33 SET PSOMSG(6)=""
+34 SET PSOMSG(7)="Please, retrieve the batch above via the View/Export Batch [PSO SPMP BATCH"
+35 SET PSOMSG(8)="VIEW/EXPORT] option and manually capture/upload the data to the State"
+36 SET PSOMSG(9)="Prescription Monitoring Program (SPMP) website for "_STANAME_"."
+37 SET PSOMSG(10)=""
+38 SET PSOMSG(11)="***************************** IMPORTANT **********************************"
+39 SET PSOMSG(12)="When you upload this file to the state website, make sure to select the"
+40 SET PSOMSG(13)="correct import option, usually called ""Back Records Out of the System"", to"
+41 SET PSOMSG(14)="avoid reporting duplicate records for the patients."
+42 SET PSOMSG(15)="**************************************************************************"
End DoDot:1
+43 ;
+44 ;Zero Report Sent
+45 IF (BATTYPE="ZY")
Begin DoDot:1
+46 SET XMSUB=STANAME_" SPMP Controlled Substance Zero Report: "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"5Z")
+47 SET PSOMSG(1)="No prescriptions met the submission criteria for Pharmacies using DEA#"_DEA
+48 SET PSOMSG(2)="A Zero Report has been created for transmission to the state."
End DoDot:1
+49 ;
+50 ;Zero Report NOT Sent
+51 IF (BATTYPE="ZN")
Begin DoDot:1
+52 NEW XDT
SET XDT=$$FMADD^XLFDT((DT\1),-1)
+53 SET XMSUB=STANAME_" SPMP Controlled Substance Zero Report: "_$$FMTE^XLFDT((XDT\1),"5Z")
+54 SET PSOMSG(1)="No prescriptions met the submission criteria. "
+55 SET PSOMSG(2)="Follow your state's guidance for manual upload of a Zero Report, if required."
End DoDot:1
+56 ;
GROUP ;
+1 SET XMTEXT="PSOMSG("
+2 ; If there are no active members in the mailgroup sends message to PSDMGR key holders
+3 IF $$GOTLOCAL^XMXAPIG("PSO SPMP NOTIFICATIONS")
Begin DoDot:1
+4 SET XMY("G.PSO SPMP NOTIFICATIONS")=""
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET USR=0
FOR
SET USR=$ORDER(^XUSEC("PSDMGR",USR))
if 'USR
QUIT
SET XMY(USR)=""
End DoDot:1
+7 ;
+8 DO ^XMD
+9 QUIT
CHK5841 ; Check the SPMP STATE PARAMETERS file (#58.41) for presence of state transmission info
+1 NEW SITEIEN,SITE,STATEIEN,STATE,FOUND,XREF,RXDT,ENDDT,RXIEN,RXFILL,FILL
+2 KILL ^TMP("PSO5841",$JOB)
+3 SET SITEIEN=0
+4 FOR
SET SITEIEN=$ORDER(^PS(59,SITEIEN))
if 'SITEIEN
QUIT
Begin DoDot:1
+5 SET STATEIEN=$$GET1^DIQ(59,SITEIEN,.08,"I")
+6 IF 'STATEIEN
QUIT
+7 IF $PIECE($$SPOK^PSOSPMUT(STATEIEN),"^")=-1
Begin DoDot:2
+8 SET FOUND=0
+9 FOR XREF="AL","AM"
Begin DoDot:3
+10 SET RXDT=$$FMADD^XLFDT(DT,-365)
SET RXDT=RXDT+.01
SET ENDDT=$$FMADD^XLFDT(DT,-1)
SET ENDDT=ENDDT+.2359
+11 FOR
SET RXDT=$ORDER(^PSRX(XREF,RXDT))
if 'RXDT!(RXDT>ENDDT)
QUIT
Begin DoDot:4
+12 SET RXIEN=0
FOR
SET RXIEN=$ORDER(^PSRX(XREF,RXDT,RXIEN))
if 'RXIEN
QUIT
if FOUND
QUIT
Begin DoDot:5
+13 SET RXFILL=""
FOR
SET RXFILL=$ORDER(^PSRX(XREF,RXDT,RXIEN,RXFILL))
if RXFILL=""
QUIT
Begin DoDot:6
+14 SET FILL=$SELECT(XREF="AL":RXFILL,1:"P"_RXFILL)
+15 IF $$RXSTATE^PSOBPSUT(RXIEN,0)'=STATEIEN
QUIT
+16 IF $$SCREEN^PSOSPMUT(RXIEN,FILL)
QUIT
+17 SET ^TMP("PSO5841",$JOB,SITEIEN)="Controlled Substance Rx found, but transmission info is missing for "_$$GET1^DIQ(59,SITEIEN,.08)_" in the SPMP STATE PARAMETERS file (#58.41)."
+18 SET FOUND=1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF $DATA(^TMP("PSO5841",$JOB))
Begin DoDot:1
+20 SET SITEIEN=0
+21 FOR
SET SITEIEN=$ORDER(^TMP("PSO5841",$JOB,SITEIEN))
if 'SITEIEN
QUIT
Begin DoDot:2
+22 SET SITE=$$GET1^DIQ(59,SITEIEN,.01)
+23 SET STATE=$$GET1^DIQ(59,SITEIEN,.08)
+24 SET XMSUB=SITE_" Controlled Substances PMP State Parameters Missing"
+25 SET PSOMSG(1)=SITE_" doesn't currently transmit controlled substance records"
+26 SET PSOMSG(2)="because it is in a state ("_STATE_") that doesn't have SPMP"
+27 SET PSOMSG(3)="state parameters defined in your VistA system. Please enter a helpdesk"
+28 SET PSOMSG(4)="ticket if you need assistance setting up SPMP state parameters for"
+29 SET PSOMSG(5)=STATE_"."
+30 DO GROUP
End DoDot:2
+31 KILL ^TMP("PSO5841",$JOB)
End DoDot:1
+32 QUIT
