- 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 Jan 18, 2025@03:36:09 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