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

PSOTPHL1.m

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