- PSOTPHL1 ;BPFO/EL-CREATE HL7 BATCH MESSAGE FILE ;09/10/03
- ;;7.0;OUTPATIENT PHARMACY;**146,153,227**;DEC 1997
- ;
- ; Summary:
- ; Use of ^VAFCQRY API is approved under private IA #3630
- ; For initial run, makes sure the "Transmission End Date" (#46.2) in
- ; File 59.7 - Pharmacy System File is null.
- ; If field (#46.2) is null, the system will pick up all DFN in File 52.91
- ; from the first date of file creation to the "RunDate"-1.
- ; If field (#46.2) has a date, the system will pick up DFN starting
- ; from the last "Transmission End Date"+1 to the "RunDate"-1.
- ; This program only runs on Sunday. RunTime will be 6pm.
- ; Tab: EN^PSOTPHL1(RDT,EDT,.SDT) is the ad-hoc entry point if user
- ; wants to run it at certain "Transmission Begin Date",
- ; "Transmission End Date", & return actual "Transmission Begin Date".
- ; If run is success, an audit node will be placed at File 59.7 as:
- ; ^PS(59.7,D0,46)=TransmissionStartDt_"^"_TransmissionEndDt_"^"_MshID_"^"_MshCnt_"^"_LineCnt
- ;
- ; At the end of each run, this program will send out mail to the mail
- ; group "PSO TPB HL7 EXTRACT" except the non-Sunday TaskMan check
- ;
- Q ; placed out of order by PSO*7*227
- N A,B,C,CK,EDT,ERR,FRTIME,I,L,R,RDT,SDT,SET,X
- N BCNT,DATA,DFN,EVENT,LN,MCNT,PGM,PS,PSO
- N BBDT,BEDT,DADT,EXC,INS,PADT,PN,REASON,STA,WAITYP
- ;
- START S CK=0 D DATE I CK=1 G ENDS
- ;
- D EN^PSOTPHL1(RDT,EDT,.SDT)
- Q
- ;
- DATE ; Check if first time run or Sunday
- S (EDT,FRTIME,PS,SET)=0,PS=59.7
- S EDT=$$GET1^DIQ(PS,"1,46",46.2,"I"),EDT=+EDT
- D NOW^%DTC
- D DW^%DTC
- I EDT'>0 S FRTIME=1 G GDATE
- I X'["SUN" S CK=1 Q
- ;
- S SDT=EDT+1
- GDATE S RDT="",SET=1
- S RDT=$S(EDT:EDT,1:0)
- S EDT=DT-1
- Q
- ;
- INIT ; Variable Initialization
- S (BCNT,LN,MCNT,CK)=0
- S PGM="PSOTPHL1"
- S PSO=52.91
- D INHL7
- ;
- K ^TMP("HLS",$J),^TMP(PGM,$J,EDT)
- ;
- Q
- ;
- INHL7 S EVENT="PSO TPB EV"
- I '$D(U) S U="^"
- D INIT^HLFNC2(EVENT,.HL)
- I $G(HL) S ERR=$P(HL,"^",2),CK=1 Q
- D CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1)
- D INHD
- Q
- ;
- INHD I '$D(DTIME) S DTIME=0
- I '$D(HL("DTM")) S HL("DTM")=HLDT1
- I '$D(HL("FS")) S HL("FS")="^"
- I '$D(HL("ECH")) S HL("ECH")="~|\&"
- I '$D(HL("ETN")) S HL("ETN")="S12"
- I '$D(HL("MTN")) S HL("MTN")="SIU"
- I '$D(HL("MTN_ETN")) S HL("MTN_ETN")="SIU_S12"
- I '$D(HL("PID")) S HL("PID")="P"
- I '$D(HL("Q")) S HL("Q")=""""
- I '$D(HL("VER")) S HL("VER")="2.4"
- I '$D(HL("CC")) S HL("CC")="US"
- I '$D(HL("ACAT")) S HL("ACAT")="AL"
- I '$D(HL("APAT")) S HL("APAT")="NE"
- I '$D(HL("SAN")) S HL("SAN")="PSO TPB-PHARM"
- I '$D(HL("RAN")) S HL("RAN")="PSO TPB-ACC"
- ;
- Q
- ;
- BHS ; CREATE "BHS" SEGMENT
- S BCNT=BCNT+1
- S LN=LN+1
- ;
- Q
- ;
- EN(RDT,EDT,SDT) ; ENTRY POINT FOR PROCESS
- D INIT I CK=1 G OUT
- D BHS
- D PROCESS
- D BTS
- G OUT
- ;
- PROCESS ; Sort and Process the message body
- I '$D(SET) S SDT=RDT,RDT=RDT-1
- I $G(FRTIME)=1 D FRTIME
- P10 S RDT=$O(^PS(PSO,"AX",RDT)) G P30:(RDT>EDT)!(RDT="")
- I SDT>RDT S SDT=RDT
- S DFN=""
- P20 S DFN=$O(^PS(PSO,"AX",RDT,DFN)) G P10:DFN=""
- I '$D(^PS(PSO,DFN,0)) K ^PS(PSO,"AX",RDT,DFN) G P20
- S ^TMP(PGM,$J,EDT,"ZZ",DFN)=RDT
- G P20
- ;
- FRTIME ; To generate a complete data set for the frist time
- S (DFN,RDT,X)=""
- S SDT=999999999
- F10 S DFN=$O(^PS(PSO,DFN)) Q:(DFN'?1N.N)!(DFN="")
- I '$D(^PS(PSO,DFN,0)) G F10
- S X=$P(^PS(PSO,DFN,0),"^",2)
- I SDT>X S SDT=X
- S ^TMP(PGM,$J,EDT,"ZZ",DFN)=X
- G F10
- ;
- P30 I '$D(^TMP(PGM,$J,EDT,"ZZ")) D G GEN
- . S MCNT=0
- . D MSH^HLFNC2(.HL,HLMID_"-"_MCNT,.X,"")
- . D WRITE
- ;
- S DFN=""
- DFN S DFN=$O(^TMP(PGM,$J,EDT,"ZZ",DFN)) G GEN:DFN=""
- S RDT=^TMP(PGM,$J,EDT,"ZZ",DFN)
- D EXTRACT
- D MSH
- D SCH
- D PID
- G DFN
- ;
- GEN S HLP="" D GENERATE^HLMA(EVENT,"GB",1,.R,HLDA,.HLP)
- Q
- ;
- S (A,B,BBDT,BEDT,C,DADT,DATA,EXC,INS,PADT,PN,REASON,STA,WAITYP,X)=""
- S X=^PS(PSO,DFN,0)
- S DATA="PN,BBDT,BEDT,REASON,DADT,WAITYP,STA,INS,EXC,PADT"
- F I=1:1:10 S @$P(DATA,",",I)=$P(X,"^",I)
- I $D(PADT) S PADT=$P(PADT,".")
- I +BBDT=+RDT S HL("ETN")="S12"
- E S HL("ETN")="S14"
- S HL("MTN_ETN")=HL("MTN")_"_"_HL("ETN")
- S A="BBDT,BEDT,DADT,PADT"
- F I=1:1:4 S B=$P(A,",",I) I $G(@B)>0 S C=$$HLDATE^HLFNC(@B,"DT"),@$P(A,",",I)=C
- Q
- ;
- MSH ; CREATE "MSH" SEGMENT
- S MCNT=MCNT+1
- D MSH^HLFNC2(.HL,HLMID_"-"_MCNT,.X,"")
- ;
- D WRITE
- Q
- ;
- SCH ; CREATE "SCH" SEGMENT
- K SCH S (X,A,B,C)="",I=0 S:REASON>9 REASON=9
- S X="Seen by VA Provider,No/Show/Cancellation,Patient Ended"
- S X=X_",Non-Formulary Rx not accepted,Patient Expired,All Rx's Inactive"
- S X=X_",Exclusion,Patient Refused Appointment,Patient Unreachable"
- S A=$P(X,",",REASON)
- ;
- S X="" S:EXC>3 EXC=3
- S X="Excluded due to active Rx#"
- S X=X_",Excluded due to actual appt<30 days from desired appt date"
- S X=X_",Exclued due to active Rx# and actual appt<30 days from desired appt date"
- S B=$P(X,",",EXC)
- ;
- I WAITYP="E" S C="EWL"
- E I WAITYP="M" S C="Manual"
- E I WAITYP="S" S C="Schedule"
- E S C="S\T\E"
- ;
- S X=""
- S X=HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_REASON_"~"_A
- S X=X_HL("FS")_EXC_"~"_B_HL("FS")_WAITYP_"~"_C
- S X=X_HL("FS")_HL("FS")_HL("FS")
- S I=I+1,SCH(I)="SCH"_X
- ;
- S X="",X=X_"~~~"_DADT_"~~~~Desired Appointment Date|~~~"
- S X=X_PADT_"~~~~Primary Care Scheduled Appointment Date|~~~"
- S X=X_BBDT_"~~~~Date Pharmacy Benefit Began|~~~"
- S X=X_BEDT_"~~~~Inactivation of Benefit Date|~~~"
- S X=X_$$HLDATE^HLFNC(RDT,"DT")_"~~~~Record Change Date"
- I $L(SCH(I)_X)<246 S SCH(I)=SCH(I)_X
- E S I=I+1,SCH(I)=X
- ;
- S X="",$P(X,"^",12)=STA_"~~~"_INS_"&"_$$GET1^DIQ(4,INS_",0",.01)
- I $L(SCH(I)_X)<246 S SCH(I)=SCH(I)_X
- E S I=I+1,SCH(I)=X
- ;
- F I=1:1 S X=$G(SCH(I)) Q:X="" D
- . I I=1 D WRITE
- . E D WRITEN
- Q
- ;
- PID ; CREATE "PID" SEGMENT
- K PID
- D DEM^VADPT,ADD^VADPT
- D BLDPID^PSOTPHL2(DFN,1,.PID,.HL,.ERR)
- Q:$G(PID(1))=""
- S X=""
- F I=1:1 S X=$G(PID(I)) Q:X="" D
- . I I=1 D WRITE
- . E D WRITEN
- Q
- ;
- BTS ; CREATE "BTS" SEGMENT
- S LN=LN+1
- Q
- ;
- WRITE ; Write single line
- S LN=LN+1
- S ^TMP("HLS",$J,LN)=X
- Q
- ;
- WRITEN ; Write multiple lines
- S ^TMP("HLS",$J,LN,I-1)=X
- Q
- ;
- CLEANUP ; Clean up variables
- K A,B,C,CK,EDT,ERR,I,L,R,RDT,SDT,X
- K BCNT,DATA,DFN,EVENT,LN,MCNT,PGM,PS,PSO
- K BBDT,BEDT,DADT,EXC,INS,PADT,PN,REASON,STA,WAITYP
- Q
- ;
- OUT ; End of compilation
- I CK=1 G END
- K ^TMP("HLS",$J),^TMP(PGM,$J,EDT),PID,SCH
- I SDT>EDT S SDT=EDT
- I $G(SET)=1 S ^PS(PS,1,46)=SDT_"^"_EDT_"^"_HLDA_"^"_MCNT_"^"_LN
- ;
- END D MAIL
- I $G(SET)'=1 D CLEANUP
- ENDS I $G(FRTIME)=1 D RESET
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- RESET ; Reset to run tomorrow
- D RESCH^XUTMOPT("PSO TPB HL7 EXTRACT","T+1@18:00","","24H","L")
- Q
- ;
- RESET1 ; Reset to run tomorrow
- D RESET,EDIT^XUTMOPT("PSO TPB HL7 EXTRACT")
- Q
- ;
- MAIL ;Send mail message
- I '$G(DUZ) Q
- K PSOTTEXT,XMY S (XMDUZ,XMSUB,XMTEST,A,B,C,I,L,R,X)=""
- S C="G.PSO TPB HL7 EXTRACT"
- S XMY(C)=""
- S PSOTTEXT(1)="SENT TO: "_C
- S XMDUZ="PSO TPB HL7 EXTRACT"
- S (A,B)=""
- I '$D(SET) S A="Ad-Hoc"
- E S A=$S(($G(FRTIME)=1):"first-time",1:"weekly")
- S B=$S(($G(CK)=1):"unsuccessful",1:"successful")
- S XMSUB="PSO TPB HL7 "_A_" update ** "_B_" **"
- S A=XMSUB
- I $G(CK)=1 D FAIL
- E D SUCC
- S PSOTTEXT(2)=" "
- S PSOTTEXT(3)="The weekly generation of the HL7 Message of"
- S PSOTTEXT(3.2)="TPB Patient Information was "_B
- S PSOTTEXT(4)=""
- S PSOTTEXT(5)=I
- S PSOTTEXT(6)=L
- S PSOTTEXT(6.2)=R
- S PSOTTEXT(6.4)=X
- S PSOTTEXT(7)=" "
- D NOW^%DTC S Y=% X ^DD("DD") S PSOTTEXT(8)="The job ended at "_$G(Y)
- S PSOTTEXT(9)=" "
- S XMTEXT="PSOTTEXT(" N DIFROM D ^XMD
- I $D(XMMG),(XMMG["Error =") D
- . K XMY(C)
- . S XMSUB=A,XMY(DUZ)="",PSOTTEXT(1)=PSOTTEXT(1)_" ("_XMMG_")",XMMG=""
- . S XMTEXT="PSOTTEXT(" D ^XMD
- K PSOTTEXT,XMDUZ,XMSUB,XMTEXT,XMY
- Q
- FAIL ; Msg for unsuccessful run
- S I="Reason: "_$S(($D(ERR)):ERR,1:"Check Event Server Protocol OR the run date")
- S L=" "
- S R="Please contact National Help Desk @888-596-4357"
- S X=" "
- Q
- ;
- SUCC ; Msg for successful run
- S I="Please check the PSOTPBAAC HL7 Logical Link to ensure"
- S L="successful transmission to the Austin Automation Center."
- S R=" "
- S X="MSH-ID: "_HLDA
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOTPHL1 8190 printed Jan 18, 2025@03:37:02 Page 2
- PSOTPHL1 ;BPFO/EL-CREATE HL7 BATCH MESSAGE FILE ;09/10/03
- +1 ;;7.0;OUTPATIENT PHARMACY;**146,153,227**;DEC 1997
- +2 ;
- +3 ; Summary:
- +4 ; Use of ^VAFCQRY API is approved under private IA #3630
- +5 ; For initial run, makes sure the "Transmission End Date" (#46.2) in
- +6 ; File 59.7 - Pharmacy System File is null.
- +7 ; If field (#46.2) is null, the system will pick up all DFN in File 52.91
- +8 ; from the first date of file creation to the "RunDate"-1.
- +9 ; If field (#46.2) has a date, the system will pick up DFN starting
- +10 ; from the last "Transmission End Date"+1 to the "RunDate"-1.
- +11 ; This program only runs on Sunday. RunTime will be 6pm.
- +12 ; Tab: EN^PSOTPHL1(RDT,EDT,.SDT) is the ad-hoc entry point if user
- +13 ; wants to run it at certain "Transmission Begin Date",
- +14 ; "Transmission End Date", & return actual "Transmission Begin Date".
- +15 ; If run is success, an audit node will be placed at File 59.7 as:
- +16 ; ^PS(59.7,D0,46)=TransmissionStartDt_"^"_TransmissionEndDt_"^"_MshID_"^"_MshCnt_"^"_LineCnt
- +17 ;
- +18 ; At the end of each run, this program will send out mail to the mail
- +19 ; group "PSO TPB HL7 EXTRACT" except the non-Sunday TaskMan check
- +20 ;
- +21 ; placed out of order by PSO*7*227
- QUIT
- +22 NEW A,B,C,CK,EDT,ERR,FRTIME,I,L,R,RDT,SDT,SET,X
- +23 NEW BCNT,DATA,DFN,EVENT,LN,MCNT,PGM,PS,PSO
- +24 NEW BBDT,BEDT,DADT,EXC,INS,PADT,PN,REASON,STA,WAITYP
- +25 ;
- START SET CK=0
- DO DATE
- IF CK=1
- GOTO ENDS
- +1 ;
- +2 DO EN^PSOTPHL1(RDT,EDT,.SDT)
- +3 QUIT
- +4 ;
- DATE ; Check if first time run or Sunday
- +1 SET (EDT,FRTIME,PS,SET)=0
- SET PS=59.7
- +2 SET EDT=$$GET1^DIQ(PS,"1,46",46.2,"I")
- SET EDT=+EDT
- +3 DO NOW^%DTC
- +4 DO DW^%DTC
- +5 IF EDT'>0
- SET FRTIME=1
- GOTO GDATE
- +6 IF X'["SUN"
- SET CK=1
- QUIT
- +7 ;
- +8 SET SDT=EDT+1
- GDATE SET RDT=""
- SET SET=1
- +1 SET RDT=$SELECT(EDT:EDT,1:0)
- +2 SET EDT=DT-1
- +3 QUIT
- +4 ;
- INIT ; Variable Initialization
- +1 SET (BCNT,LN,MCNT,CK)=0
- +2 SET PGM="PSOTPHL1"
- +3 SET PSO=52.91
- +4 DO INHL7
- +5 ;
- +6 KILL ^TMP("HLS",$JOB),^TMP(PGM,$JOB,EDT)
- +7 ;
- +8 QUIT
- +9 ;
- INHL7 SET EVENT="PSO TPB EV"
- +1 IF '$DATA(U)
- SET U="^"
- +2 DO INIT^HLFNC2(EVENT,.HL)
- +3 IF $GET(HL)
- SET ERR=$PIECE(HL,"^",2)
- SET CK=1
- QUIT
- +4 DO CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1)
- +5 DO INHD
- +6 QUIT
- +7 ;
- INHD IF '$DATA(DTIME)
- SET DTIME=0
- +1 IF '$DATA(HL("DTM"))
- SET HL("DTM")=HLDT1
- +2 IF '$DATA(HL("FS"))
- SET HL("FS")="^"
- +3 IF '$DATA(HL("ECH"))
- SET HL("ECH")="~|\&"
- +4 IF '$DATA(HL("ETN"))
- SET HL("ETN")="S12"
- +5 IF '$DATA(HL("MTN"))
- SET HL("MTN")="SIU"
- +6 IF '$DATA(HL("MTN_ETN"))
- SET HL("MTN_ETN")="SIU_S12"
- +7 IF '$DATA(HL("PID"))
- SET HL("PID")="P"
- +8 IF '$DATA(HL("Q"))
- SET HL("Q")=""""
- +9 IF '$DATA(HL("VER"))
- SET HL("VER")="2.4"
- +10 IF '$DATA(HL("CC"))
- SET HL("CC")="US"
- +11 IF '$DATA(HL("ACAT"))
- SET HL("ACAT")="AL"
- +12 IF '$DATA(HL("APAT"))
- SET HL("APAT")="NE"
- +13 IF '$DATA(HL("SAN"))
- SET HL("SAN")="PSO TPB-PHARM"
- +14 IF '$DATA(HL("RAN"))
- SET HL("RAN")="PSO TPB-ACC"
- +15 ;
- +16 QUIT
- +17 ;
- BHS ; CREATE "BHS" SEGMENT
- +1 SET BCNT=BCNT+1
- +2 SET LN=LN+1
- +3 ;
- +4 QUIT
- +5 ;
- EN(RDT,EDT,SDT) ; ENTRY POINT FOR PROCESS
- +1 DO INIT
- IF CK=1
- GOTO OUT
- +2 DO BHS
- +3 DO PROCESS
- +4 DO BTS
- +5 GOTO OUT
- +6 ;
- PROCESS ; Sort and Process the message body
- +1 IF '$DATA(SET)
- SET SDT=RDT
- SET RDT=RDT-1
- +2 IF $GET(FRTIME)=1
- DO FRTIME
- P10 SET RDT=$ORDER(^PS(PSO,"AX",RDT))
- if (RDT>EDT)!(RDT="")
- GOTO P30
- +1 IF SDT>RDT
- SET SDT=RDT
- +2 SET DFN=""
- P20 SET DFN=$ORDER(^PS(PSO,"AX",RDT,DFN))
- if DFN=""
- GOTO P10
- +1 IF '$DATA(^PS(PSO,DFN,0))
- KILL ^PS(PSO,"AX",RDT,DFN)
- GOTO P20
- +2 SET ^TMP(PGM,$JOB,EDT,"ZZ",DFN)=RDT
- +3 GOTO P20
- +4 ;
- FRTIME ; To generate a complete data set for the frist time
- +1 SET (DFN,RDT,X)=""
- +2 SET SDT=999999999
- F10 SET DFN=$ORDER(^PS(PSO,DFN))
- if (DFN'?1N.N)!(DFN="")
- QUIT
- +1 IF '$DATA(^PS(PSO,DFN,0))
- GOTO F10
- +2 SET X=$PIECE(^PS(PSO,DFN,0),"^",2)
- +3 IF SDT>X
- SET SDT=X
- +4 SET ^TMP(PGM,$JOB,EDT,"ZZ",DFN)=X
- +5 GOTO F10
- +6 ;
- P30 IF '$DATA(^TMP(PGM,$JOB,EDT,"ZZ"))
- Begin DoDot:1
- +1 SET MCNT=0
- +2 DO MSH^HLFNC2(.HL,HLMID_"-"_MCNT,.X,"")
- +3 DO WRITE
- End DoDot:1
- GOTO GEN
- +4 ;
- +5 SET DFN=""
- DFN SET DFN=$ORDER(^TMP(PGM,$JOB,EDT,"ZZ",DFN))
- if DFN=""
- GOTO GEN
- +1 SET RDT=^TMP(PGM,$JOB,EDT,"ZZ",DFN)
- +2 DO EXTRACT
- +3 DO MSH
- +4 DO SCH
- +5 DO PID
- +6 GOTO DFN
- +7 ;
- GEN SET HLP=""
- DO GENERATE^HLMA(EVENT,"GB",1,.R,HLDA,.HLP)
- +1 QUIT
- +2 ;
- +1 SET (A,B,BBDT,BEDT,C,DADT,DATA,EXC,INS,PADT,PN,REASON,STA,WAITYP,X)=""
- +2 SET X=^PS(PSO,DFN,0)
- +3 SET DATA="PN,BBDT,BEDT,REASON,DADT,WAITYP,STA,INS,EXC,PADT"
- +4 FOR I=1:1:10
- SET @$PIECE(DATA,",",I)=$PIECE(X,"^",I)
- +5 IF $DATA(PADT)
- SET PADT=$PIECE(PADT,".")
- +6 IF +BBDT=+RDT
- SET HL("ETN")="S12"
- +7 IF '$TEST
- SET HL("ETN")="S14"
- +8 SET HL("MTN_ETN")=HL("MTN")_"_"_HL("ETN")
- +9 SET A="BBDT,BEDT,DADT,PADT"
- +10 FOR I=1:1:4
- SET B=$PIECE(A,",",I)
- IF $GET(@B)>0
- SET C=$$HLDATE^HLFNC(@B,"DT")
- SET @$PIECE(A,",",I)=C
- +11 QUIT
- +12 ;
- MSH ; CREATE "MSH" SEGMENT
- +1 SET MCNT=MCNT+1
- +2 DO MSH^HLFNC2(.HL,HLMID_"-"_MCNT,.X,"")
- +3 ;
- +4 DO WRITE
- +5 QUIT
- +6 ;
- SCH ; CREATE "SCH" SEGMENT
- +1 KILL SCH
- SET (X,A,B,C)=""
- SET I=0
- if REASON>9
- SET REASON=9
- +2 SET X="Seen by VA Provider,No/Show/Cancellation,Patient Ended"
- +3 SET X=X_",Non-Formulary Rx not accepted,Patient Expired,All Rx's Inactive"
- +4 SET X=X_",Exclusion,Patient Refused Appointment,Patient Unreachable"
- +5 SET A=$PIECE(X,",",REASON)
- +6 ;
- +7 SET X=""
- if EXC>3
- SET EXC=3
- +8 SET X="Excluded due to active Rx#"
- +9 SET X=X_",Excluded due to actual appt<30 days from desired appt date"
- +10 SET X=X_",Exclued due to active Rx# and actual appt<30 days from desired appt date"
- +11 SET B=$PIECE(X,",",EXC)
- +12 ;
- +13 IF WAITYP="E"
- SET C="EWL"
- +14 IF '$TEST
- IF WAITYP="M"
- SET C="Manual"
- +15 IF '$TEST
- IF WAITYP="S"
- SET C="Schedule"
- +16 IF '$TEST
- SET C="S\T\E"
- +17 ;
- +18 SET X=""
- +19 SET X=HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_REASON_"~"_A
- +20 SET X=X_HL("FS")_EXC_"~"_B_HL("FS")_WAITYP_"~"_C
- +21 SET X=X_HL("FS")_HL("FS")_HL("FS")
- +22 SET I=I+1
- SET SCH(I)="SCH"_X
- +23 ;
- +24 SET X=""
- SET X=X_"~~~"_DADT_"~~~~Desired Appointment Date|~~~"
- +25 SET X=X_PADT_"~~~~Primary Care Scheduled Appointment Date|~~~"
- +26 SET X=X_BBDT_"~~~~Date Pharmacy Benefit Began|~~~"
- +27 SET X=X_BEDT_"~~~~Inactivation of Benefit Date|~~~"
- +28 SET X=X_$$HLDATE^HLFNC(RDT,"DT")_"~~~~Record Change Date"
- +29 IF $LENGTH(SCH(I)_X)<246
- SET SCH(I)=SCH(I)_X
- +30 IF '$TEST
- SET I=I+1
- SET SCH(I)=X
- +31 ;
- +32 SET X=""
- SET $PIECE(X,"^",12)=STA_"~~~"_INS_"&"_$$GET1^DIQ(4,INS_",0",.01)
- +33 IF $LENGTH(SCH(I)_X)<246
- SET SCH(I)=SCH(I)_X
- +34 IF '$TEST
- SET I=I+1
- SET SCH(I)=X
- +35 ;
- +36 FOR I=1:1
- SET X=$GET(SCH(I))
- if X=""
- QUIT
- Begin DoDot:1
- +37 IF I=1
- DO WRITE
- +38 IF '$TEST
- DO WRITEN
- End DoDot:1
- +39 QUIT
- +40 ;
- PID ; CREATE "PID" SEGMENT
- +1 KILL PID
- +2 DO DEM^VADPT
- DO ADD^VADPT
- +3 DO BLDPID^PSOTPHL2(DFN,1,.PID,.HL,.ERR)
- +4 if $GET(PID(1))=""
- QUIT
- +5 SET X=""
- +6 FOR I=1:1
- SET X=$GET(PID(I))
- if X=""
- QUIT
- Begin DoDot:1
- +7 IF I=1
- DO WRITE
- +8 IF '$TEST
- DO WRITEN
- End DoDot:1
- +9 QUIT
- +10 ;
- BTS ; CREATE "BTS" SEGMENT
- +1 SET LN=LN+1
- +2 QUIT
- +3 ;
- WRITE ; Write single line
- +1 SET LN=LN+1
- +2 SET ^TMP("HLS",$JOB,LN)=X
- +3 QUIT
- +4 ;
- WRITEN ; Write multiple lines
- +1 SET ^TMP("HLS",$JOB,LN,I-1)=X
- +2 QUIT
- +3 ;
- CLEANUP ; Clean up variables
- +1 KILL A,B,C,CK,EDT,ERR,I,L,R,RDT,SDT,X
- +2 KILL BCNT,DATA,DFN,EVENT,LN,MCNT,PGM,PS,PSO
- +3 KILL BBDT,BEDT,DADT,EXC,INS,PADT,PN,REASON,STA,WAITYP
- +4 QUIT
- +5 ;
- OUT ; End of compilation
- +1 IF CK=1
- GOTO END
- +2 KILL ^TMP("HLS",$JOB),^TMP(PGM,$JOB,EDT),PID,SCH
- +3 IF SDT>EDT
- SET SDT=EDT
- +4 IF $GET(SET)=1
- SET ^PS(PS,1,46)=SDT_"^"_EDT_"^"_HLDA_"^"_MCNT_"^"_LN
- +5 ;
- END DO MAIL
- +1 IF $GET(SET)'=1
- DO CLEANUP
- ENDS IF $GET(FRTIME)=1
- DO RESET
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 QUIT
- +3 ;
- RESET ; Reset to run tomorrow
- +1 DO RESCH^XUTMOPT("PSO TPB HL7 EXTRACT","T+1@18:00","","24H","L")
- +2 QUIT
- +3 ;
- RESET1 ; Reset to run tomorrow
- +1 DO RESET
- DO EDIT^XUTMOPT("PSO TPB HL7 EXTRACT")
- +2 QUIT
- +3 ;
- MAIL ;Send mail message
- +1 IF '$GET(DUZ)
- QUIT
- +2 KILL PSOTTEXT,XMY
- SET (XMDUZ,XMSUB,XMTEST,A,B,C,I,L,R,X)=""
- +3 SET C="G.PSO TPB HL7 EXTRACT"
- +4 SET XMY(C)=""
- +5 SET PSOTTEXT(1)="SENT TO: "_C
- +6 SET XMDUZ="PSO TPB HL7 EXTRACT"
- +7 SET (A,B)=""
- +8 IF '$DATA(SET)
- SET A="Ad-Hoc"
- +9 IF '$TEST
- SET A=$SELECT(($GET(FRTIME)=1):"first-time",1:"weekly")
- +10 SET B=$SELECT(($GET(CK)=1):"unsuccessful",1:"successful")
- +11 SET XMSUB="PSO TPB HL7 "_A_" update ** "_B_" **"
- +12 SET A=XMSUB
- +13 IF $GET(CK)=1
- DO FAIL
- +14 IF '$TEST
- DO SUCC
- +15 SET PSOTTEXT(2)=" "
- +16 SET PSOTTEXT(3)="The weekly generation of the HL7 Message of"
- +17 SET PSOTTEXT(3.2)="TPB Patient Information was "_B
- +18 SET PSOTTEXT(4)=""
- +19 SET PSOTTEXT(5)=I
- +20 SET PSOTTEXT(6)=L
- +21 SET PSOTTEXT(6.2)=R
- +22 SET PSOTTEXT(6.4)=X
- +23 SET PSOTTEXT(7)=" "
- +24 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET PSOTTEXT(8)="The job ended at "_$GET(Y)
- +25 SET PSOTTEXT(9)=" "
- +26 SET XMTEXT="PSOTTEXT("
- NEW DIFROM
- DO ^XMD
- +27 IF $DATA(XMMG)
- IF (XMMG["Error =")
- Begin DoDot:1
- +28 KILL XMY(C)
- +29 SET XMSUB=A
- SET XMY(DUZ)=""
- SET PSOTTEXT(1)=PSOTTEXT(1)_" ("_XMMG_")"
- SET XMMG=""
- +30 SET XMTEXT="PSOTTEXT("
- DO ^XMD
- End DoDot:1
- +31 KILL PSOTTEXT,XMDUZ,XMSUB,XMTEXT,XMY
- +32 QUIT
- FAIL ; Msg for unsuccessful run
- +1 SET I="Reason: "_$SELECT(($DATA(ERR)):ERR,1:"Check Event Server Protocol OR the run date")
- +2 SET L=" "
- +3 SET R="Please contact National Help Desk @888-596-4357"
- +4 SET X=" "
- +5 QUIT
- +6 ;
- SUCC ; Msg for successful run
- +1 SET I="Please check the PSOTPBAAC HL7 Logical Link to ensure"
- +2 SET L="successful transmission to the Austin Automation Center."
- +3 SET R=" "
- +4 SET X="MSH-ID: "_HLDA
- +5 QUIT
- +6 ;