- PSULRHL3 ;HCIOFO/BH - Daily file procesing ; 4/28/04 3:10pm
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**3**;MARCH, 2005
- ;
- ; ** THIS ROUTINE SHOULD NEVER BE INSTALLED AT A SITE ***
- ; ** THIS ROUTINE IS ONLY TO BE RUN ON THE CMOP-NAT SERVER ***
- ;
- Q
- ;
- PROCESS ; This process loops through the file containing parsed HL7 data.
- ; This process runs each day and collects up to the previous days data.
- ; The data is ordered by facility. All the data for the facility for
- ; for up to the previous day gets filed into one flat file for PBM to
- ; process. A pre-init sub routine CULL loops through all x-refs that
- ; indicate processed data for facility and date and culls the data and
- ; removes the FD x-ref.
- ;
- ;
- D CULL
- ;
- ;
- N DFN,EDATE,FACILITY,FILE,IEN,OPEN,OUTDIR,PSUDTE,QUIT,RDATE,RC,SDATE,TEMP,X,X1,X2
- ;
- ; End date for search
- D NOW^%DTC S TEMP=%,EDATE=$P(TEMP,".",1)
- ; Run date i.e. going to process data up to yesterday
- S X1=$P(TEMP,".",1),X2="-1" D C^%DTC S RDATE=$P(X,".",1)
- ;
- ;
- S FACILITY="",(QUIT,OPEN)=0
- ;
- F S FACILITY=$O(^DIZ(99999,"FDP",FACILITY)) Q:'FACILITY!(QUIT) D
- . ;
- . I $D(^DIZ(99999,"FD",FACILITY,RDATE)) D Q
- . . D ERROR(3,FACILITY,RDATE) Q
- . ; New facility so close any open files.
- . I OPEN D CLOSE S OPEN=0
- . S DATE="0"
- . F S DATE=$O(^DIZ(99999,"FDP",FACILITY,DATE)) Q:'DATE!(DATE'<EDATE)!(QUIT) D
- . . ;
- . . S DFN=""
- . . F S DFN=$O(^DIZ(99999,"FDP",FACILITY,DATE,DFN)) Q:'DFN!(QUIT) D
- . . . S IEN=""
- . . . F S IEN=$O(^DIZ(99999,"FDP",FACILITY,DATE,DFN,IEN)) Q:'IEN!(QUIT) D
- . . . . I 'OPEN D Q:'RC
- . . . . . S RC=$$OPEN()
- . . . . . I 'RC S QUIT=1 Q
- . . . . . S OPEN=1
- . . . . D FILE
- I OPEN D CLOSE
- Q
- ;
- ;
- OPEN() ; Open the output directory
- N DST,POP,SRC
- S FILE=FACILITY_DT_".DAT"
- ;S OUTDIR="W:\PBM\National-PBM"
- S OUTDIR="USER$:[PBM.LAB]"
- ;
- K DST,SRC
- S SRC(FILE)=""
- I $$LIST^%ZISH(OUTDIR,"SRC","DST") D ERROR(2,FACILITY,FILE) Q 0
- ;
- D OPEN^%ZISH("HL7FILE",OUTDIR,FILE,"W")
- I $G(POP) D ERROR(1,FACILITY,OUTDIR_FILE) Q 0
- ;
- Q 1
- ;
- CLOSE ; Set Cross ref indicating that facilities data for the day got
- ; processed, and close the output file.
- N FDA
- K FDA
- S FDA(99999,"+1,",.01)=$E(FILE,1,3)
- S FDA(99999,"+1,",.03)=RDATE
- D UPDATE^DIE("","FDA",)
- D CLOSE^%ZISH("HL7FILE")
- Q
- ;
- FILE ; File the lab data to the output file in the following single string format.
- ;
- ; PAT|Facility|ICN|SSN|DFN|Date/Time Specimen Collected|Site/Specimen|Local Lab Number^Local Lab Name|
- ; NLT Code^NLT Name|LOINC Code^LOINC Name|Result|Units|Low Range|High Range|
- ;
- ;
- N CNT,CR,DFN,FAC,HRANGE,ICN,LABA,LABB,LABC,LNCODE,LNNAME,LOCALLAB,LRANGE,NLTCODE,NLTNAME,RANGE,REC,RESIEN,RESREC,RESREC1,RESULT,SPEC,SPECDATE,SPECREC,SPECIEN,SSN,STR,STR1,TEST,UNITS
- ;
- U IO
- S REC=^DIZ(99999,IEN,0)
- S SSN=$P(REC,U,5),ICN=$P(REC,U,4),FAC=$P(REC,U,1),DFN=$P(REC,U,2)
- ;
- S SPECIEN=0
- F S SPECIEN=$O(^DIZ(99999,IEN,1,SPECIEN)) Q:'SPECIEN D
- . ; Do not file if Specimen has no results
- . S TEST=0
- . S TEST=$O(^DIZ(99999,IEN,1,SPECIEN,1,TEST)) Q:'TEST
- . S SPECREC=^DIZ(99999,IEN,1,SPECIEN,0)
- . S SPEC=$P(SPECREC,U,1),SPECDATE=$P(SPECREC,U,2)
- . S STR="PAT|"_FAC_"|"_ICN_"|"_SSN_"|"_DFN_"|"_SPECDATE_"|"_SPEC
- . ;W STR
- . S RESIEN=0
- . ;S CNT=0
- . F S RESIEN=$O(^DIZ(99999,IEN,1,SPECIEN,1,RESIEN)) Q:'RESIEN D
- . . S RESREC=^DIZ(99999,IEN,1,SPECIEN,1,RESIEN,0)
- . . S RESREC1=^DIZ(99999,IEN,1,SPECIEN,1,RESIEN,2)
- . . ;S CNT=CNT+1
- . . S LOCALLAB=$P(RESREC,U,6),NLTCODE=$P(RESREC,U,2)
- . . S NLTNAME=$P(RESREC,U,3),LNNAME=$P(RESREC,U,5)
- . . S LNCODE=$P(RESREC,U,4),RESULT=$P(RESREC,U,1)
- . . S UNITS=$P(RESREC1,U,1),RANGE=$P(RESREC1,U,2)
- . . ; Most of the time High and Low range are separated by a "-"
- . . I RANGE["-" D
- . . . S LRANGE=$P(RANGE,"-",1),HRANGE=$P(RANGE,"-",2)
- . . I RANGE'["-" D
- . . . S LRANGE=RANGE,HRANGE=""
- . . S LABA="|^"_LOCALLAB_"|"_NLTCODE_"^"_NLTNAME_"|"_LNCODE_"^"_LNNAME_"|"
- . . ;
- . . S LABB=RESULT_"|"_UNITS_"|"
- . . ;
- . . S LABC=LRANGE_"|"_HRANGE_"|"
- . . W STR_LABA_LABB_LABC,!
- Q
- ;
- ERROR(CODE,FAC,MESSAGE) ; Error processing
- N ARR,STR
- I CODE=1 S STR=DT_": Cannot open output file "_MESSAGE
- I CODE=2 S STR=DT_": File name already exists in the output directory "_MESSAGE
- I CODE=3 D
- . S MESSAGE=$E(MESSAGE,4,5)_"/"_$E(MESSAGE,6,7)_"/"_$E(MESSAGE,2,3)
- . S STR=DT_": Trying to process records for Facility #"_FAC_" for the date of "_MESSAGE_" that have already been processed."
- S FDA(99999,"+1,",.01)=FAC
- S FDA(99999,"+1,",2)=STR
- D UPDATE^DIE("","FDA",)
- Q
- ;
- ;
- CULL ; Cull all entries for a facility that have been processed on or before the date in FD x-ref
- N A,B,DFN,DELLIEN,FAC,IDATE,IEN,PDATE
- S FAC="0"
- F S FAC=$O(^DIZ(99999,"FD",FAC)) Q:'FAC D
- . S PDATE=0
- . F S PDATE=$O(^DIZ(99999,"FD",FAC,PDATE)) Q:'PDATE D
- . . S IDATE=0
- . . ; Remove entry with FD x-ref
- . . S DELLIEN=0
- . . S DELLIEN=$O(^DIZ(99999,"FD",FAC,PDATE,DELLIEN))
- . . K B
- . . S B(99999,DELLIEN_",",.01)="@" D FILE^DIE(,"B")
- . . ;
- . . F S IDATE=$O(^DIZ(99999,"FDP",FAC,IDATE)) Q:'IDATE!($P(IDATE,".",1)>PDATE) D
- . . . S DFN=0
- . . . F S DFN=$O(^DIZ(99999,"FDP",FAC,IDATE,DFN)) Q:'DFN D
- . . . . S IEN=0
- . . . . F S IEN=$O(^DIZ(99999,"FDP",FAC,IDATE,DFN,IEN)) Q:'IEN D
- . . . . . K A
- . . . . . S A(99999,IEN_",",.01)="@" D FILE^DIE(,"A")
- Q
- ;
- ;
- ERORDSP ; Display errors
- ;
- N DATE,DONE,EDATE,FAC,IEN,PG
- S PG=0,DATE=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
- D HEAD
- I '$D(^DIZ(99999,"FDE")) W "No Error's to report." H 4 Q
- ;
- ;
- S FAC="0"
- F S FAC=$O(^DIZ(99999,"FDE",FAC)) Q:'FAC D
- . ;
- . S EDATE=0
- . F S EDATE=$O(^DIZ(99999,"FDE",FAC,EDATE)) Q:'EDATE D
- . . S IEN=0
- . . F S IEN=$O(^DIZ(99999,"FDE",FAC,EDATE,IEN)) Q:'IEN D
- . . . S MSG=^DIZ(99999,IEN,2)
- . . . I ($Y+4>IOSL) D PRTC Q:$D(DONE) D HEAD
- . . . W !," "_MSG,!
- Q
- ;
- HEAD ;
- W:$Y>0 @IOF S PG=PG+1
- W " "_DATE,?71,"Page ",PG,!!
- W " Error log for PBM III national database processing.",!
- W " ---------------------------------------------------",!
- Q
- ;
- PRTC ;press return to continue prompt
- Q:$E(IOST,1,2)'="C-"!($D(IO("S")))
- K DIR W ! S DIR(0)="E" D ^DIR K DIR I 'Y S DONE=1
- Q
- ;
- ;
- PSULRHL3 ;HCIOFO/BH - Daily file procesing ; 4/28/04 3:10pm
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**3**;MARCH, 2005
- +2 ;
- +3 ; ** THIS ROUTINE SHOULD NEVER BE INSTALLED AT A SITE ***
- +4 ; ** THIS ROUTINE IS ONLY TO BE RUN ON THE CMOP-NAT SERVER ***
- +5 ;
- +6 QUIT
- +7 ;
- PROCESS ; This process loops through the file containing parsed HL7 data.
- +1 ; This process runs each day and collects up to the previous days data.
- +2 ; The data is ordered by facility. All the data for the facility for
- +3 ; for up to the previous day gets filed into one flat file for PBM to
- +4 ; process. A pre-init sub routine CULL loops through all x-refs that
- +5 ; indicate processed data for facility and date and culls the data and
- +6 ; removes the FD x-ref.
- +7 ;
- +8 ;
- +9 DO CULL
- +10 ;
- +11 ;
- +12 NEW DFN,EDATE,FACILITY,FILE,IEN,OPEN,OUTDIR,PSUDTE,QUIT,RDATE,RC,SDATE,TEMP,X,X1,X2
- +13 ;
- +14 ; End date for search
- +15 DO NOW^%DTC
- SET TEMP=%
- SET EDATE=$PIECE(TEMP,".",1)
- +16 ; Run date i.e. going to process data up to yesterday
- +17 SET X1=$PIECE(TEMP,".",1)
- SET X2="-1"
- DO C^%DTC
- SET RDATE=$PIECE(X,".",1)
- +18 ;
- +19 ;
- +20 SET FACILITY=""
- SET (QUIT,OPEN)=0
- +21 ;
- +22 FOR
- SET FACILITY=$ORDER(^DIZ(99999,"FDP",FACILITY))
- IF 'FACILITY!(QUIT)
- QUIT
- Begin DoDot:1
- +23 ;
- +24 IF $DATA(^DIZ(99999,"FD",FACILITY,RDATE))
- Begin DoDot:2
- +25 DO ERROR(3,FACILITY,RDATE)
- QUIT
- End DoDot:2
- QUIT
- +26 ; New facility so close any open files.
- +27 IF OPEN
- DO CLOSE
- SET OPEN=0
- +28 SET DATE="0"
- +29 FOR
- SET DATE=$ORDER(^DIZ(99999,"FDP",FACILITY,DATE))
- IF 'DATE!(DATE'<EDATE)!(QUIT)
- QUIT
- Begin DoDot:2
- +30 ;
- +31 SET DFN=""
- +32 FOR
- SET DFN=$ORDER(^DIZ(99999,"FDP",FACILITY,DATE,DFN))
- IF 'DFN!(QUIT)
- QUIT
- Begin DoDot:3
- +33 SET IEN=""
- +34 FOR
- SET IEN=$ORDER(^DIZ(99999,"FDP",FACILITY,DATE,DFN,IEN))
- IF 'IEN!(QUIT)
- QUIT
- Begin DoDot:4
- +35 IF 'OPEN
- Begin DoDot:5
- +36 SET RC=$$OPEN()
- +37 IF 'RC
- SET QUIT=1
- QUIT
- +38 SET OPEN=1
- End DoDot:5
- IF 'RC
- QUIT
- +39 DO FILE
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +40 IF OPEN
- DO CLOSE
- +41 QUIT
- +42 ;
- +43 ;
- OPEN() ; Open the output directory
- +1 NEW DST,POP,SRC
- +2 SET FILE=FACILITY_DT_".DAT"
- +3 ;S OUTDIR="W:\PBM\National-PBM"
- +4 SET OUTDIR="USER$:[PBM.LAB]"
- +5 ;
- +6 KILL DST,SRC
- +7 SET SRC(FILE)=""
- +8 IF $$LIST^%ZISH(OUTDIR,"SRC","DST")
- DO ERROR(2,FACILITY,FILE)
- QUIT 0
- +9 ;
- +10 DO OPEN^%ZISH("HL7FILE",OUTDIR,FILE,"W")
- +11 IF $GET(POP)
- DO ERROR(1,FACILITY,OUTDIR_FILE)
- QUIT 0
- +12 ;
- +13 QUIT 1
- +14 ;
- CLOSE ; Set Cross ref indicating that facilities data for the day got
- +1 ; processed, and close the output file.
- +2 NEW FDA
- +3 KILL FDA
- +4 SET FDA(99999,"+1,",.01)=$EXTRACT(FILE,1,3)
- +5 SET FDA(99999,"+1,",.03)=RDATE
- +6 DO UPDATE^DIE("","FDA",)
- +7 DO CLOSE^%ZISH("HL7FILE")
- +8 QUIT
- +9 ;
- FILE ; File the lab data to the output file in the following single string format.
- +1 ;
- +2 ; PAT|Facility|ICN|SSN|DFN|Date/Time Specimen Collected|Site/Specimen|Local Lab Number^Local Lab Name|
- +3 ; NLT Code^NLT Name|LOINC Code^LOINC Name|Result|Units|Low Range|High Range|
- +4 ;
- +5 ;
- +6 NEW CNT,CR,DFN,FAC,HRANGE,ICN,LABA,LABB,LABC,LNCODE,LNNAME,LOCALLAB,LRANGE,NLTCODE,NLTNAME,RANGE,REC,RESIEN,RESREC,RESREC1,RESULT,SPEC,SPECDATE,SPECREC,SPECIEN,SSN,STR,STR1,TEST,UNITS
- +7 ;
- +8 USE IO
- +9 SET REC=^DIZ(99999,IEN,0)
- +10 SET SSN=$PIECE(REC,U,5)
- SET ICN=$PIECE(REC,U,4)
- SET FAC=$PIECE(REC,U,1)
- SET DFN=$PIECE(REC,U,2)
- +11 ;
- +12 SET SPECIEN=0
- +13 FOR
- SET SPECIEN=$ORDER(^DIZ(99999,IEN,1,SPECIEN))
- IF 'SPECIEN
- QUIT
- Begin DoDot:1
- +14 ; Do not file if Specimen has no results
- +15 SET TEST=0
- +16 SET TEST=$ORDER(^DIZ(99999,IEN,1,SPECIEN,1,TEST))
- IF 'TEST
- QUIT
- +17 SET SPECREC=^DIZ(99999,IEN,1,SPECIEN,0)
- +18 SET SPEC=$PIECE(SPECREC,U,1)
- SET SPECDATE=$PIECE(SPECREC,U,2)
- +19 SET STR="PAT|"_FAC_"|"_ICN_"|"_SSN_"|"_DFN_"|"_SPECDATE_"|"_SPEC
- +20 ;W STR
- +21 SET RESIEN=0
- +22 ;S CNT=0
- +23 FOR
- SET RESIEN=$ORDER(^DIZ(99999,IEN,1,SPECIEN,1,RESIEN))
- IF 'RESIEN
- QUIT
- Begin DoDot:2
- +24 SET RESREC=^DIZ(99999,IEN,1,SPECIEN,1,RESIEN,0)
- +25 SET RESREC1=^DIZ(99999,IEN,1,SPECIEN,1,RESIEN,2)
- +26 ;S CNT=CNT+1
- +27 SET LOCALLAB=$PIECE(RESREC,U,6)
- SET NLTCODE=$PIECE(RESREC,U,2)
- +28 SET NLTNAME=$PIECE(RESREC,U,3)
- SET LNNAME=$PIECE(RESREC,U,5)
- +29 SET LNCODE=$PIECE(RESREC,U,4)
- SET RESULT=$PIECE(RESREC,U,1)
- +30 SET UNITS=$PIECE(RESREC1,U,1)
- SET RANGE=$PIECE(RESREC1,U,2)
- +31 ; Most of the time High and Low range are separated by a "-"
- +32 IF RANGE["-"
- Begin DoDot:3
- +33 SET LRANGE=$PIECE(RANGE,"-",1)
- SET HRANGE=$PIECE(RANGE,"-",2)
- End DoDot:3
- +34 IF RANGE'["-"
- Begin DoDot:3
- +35 SET LRANGE=RANGE
- SET HRANGE=""
- End DoDot:3
- +36 SET LABA="|^"_LOCALLAB_"|"_NLTCODE_"^"_NLTNAME_"|"_LNCODE_"^"_LNNAME_"|"
- +37 ;
- +38 SET LABB=RESULT_"|"_UNITS_"|"
- +39 ;
- +40 SET LABC=LRANGE_"|"_HRANGE_"|"
- +41 WRITE STR_LABA_LABB_LABC,!
- End DoDot:2
- End DoDot:1
- +42 QUIT
- +43 ;
- ERROR(CODE,FAC,MESSAGE) ; Error processing
- +1 NEW ARR,STR
- +2 IF CODE=1
- SET STR=DT_": Cannot open output file "_MESSAGE
- +3 IF CODE=2
- SET STR=DT_": File name already exists in the output directory "_MESSAGE
- +4 IF CODE=3
- Begin DoDot:1
- +5 SET MESSAGE=$EXTRACT(MESSAGE,4,5)_"/"_$EXTRACT(MESSAGE,6,7)_"/"_$EXTRACT(MESSAGE,2,3)
- +6 SET STR=DT_": Trying to process records for Facility #"_FAC_" for the date of "_MESSAGE_" that have already been processed."
- End DoDot:1
- +7 SET FDA(99999,"+1,",.01)=FAC
- +8 SET FDA(99999,"+1,",2)=STR
- +9 DO UPDATE^DIE("","FDA",)
- +10 QUIT
- +11 ;
- +12 ;
- CULL ; Cull all entries for a facility that have been processed on or before the date in FD x-ref
- +1 NEW A,B,DFN,DELLIEN,FAC,IDATE,IEN,PDATE
- +2 SET FAC="0"
- +3 FOR
- SET FAC=$ORDER(^DIZ(99999,"FD",FAC))
- IF 'FAC
- QUIT
- Begin DoDot:1
- +4 SET PDATE=0
- +5 FOR
- SET PDATE=$ORDER(^DIZ(99999,"FD",FAC,PDATE))
- IF 'PDATE
- QUIT
- Begin DoDot:2
- +6 SET IDATE=0
- +7 ; Remove entry with FD x-ref
- +8 SET DELLIEN=0
- +9 SET DELLIEN=$ORDER(^DIZ(99999,"FD",FAC,PDATE,DELLIEN))
- +10 KILL B
- +11 SET B(99999,DELLIEN_",",.01)="@"
- DO FILE^DIE(,"B")
- +12 ;
- +13 FOR
- SET IDATE=$ORDER(^DIZ(99999,"FDP",FAC,IDATE))
- IF 'IDATE!($PIECE(IDATE,".",1)>PDATE)
- QUIT
- Begin DoDot:3
- +14 SET DFN=0
- +15 FOR
- SET DFN=$ORDER(^DIZ(99999,"FDP",FAC,IDATE,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:4
- +16 SET IEN=0
- +17 FOR
- SET IEN=$ORDER(^DIZ(99999,"FDP",FAC,IDATE,DFN,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:5
- +18 KILL A
- +19 SET A(99999,IEN_",",.01)="@"
- DO FILE^DIE(,"A")
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +20 QUIT
- +21 ;
- +22 ;
- ERORDSP ; Display errors
- +1 ;
- +2 NEW DATE,DONE,EDATE,FAC,IEN,PG
- +3 SET PG=0
- SET DATE=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
- +4 DO HEAD
- +5 IF '$DATA(^DIZ(99999,"FDE"))
- WRITE "No Error's to report."
- HANG 4
- QUIT
- +6 ;
- +7 ;
- +8 SET FAC="0"
- +9 FOR
- SET FAC=$ORDER(^DIZ(99999,"FDE",FAC))
- IF 'FAC
- QUIT
- Begin DoDot:1
- +10 ;
- +11 SET EDATE=0
- +12 FOR
- SET EDATE=$ORDER(^DIZ(99999,"FDE",FAC,EDATE))
- IF 'EDATE
- QUIT
- Begin DoDot:2
- +13 SET IEN=0
- +14 FOR
- SET IEN=$ORDER(^DIZ(99999,"FDE",FAC,EDATE,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:3
- +15 SET MSG=^DIZ(99999,IEN,2)
- +16 IF ($Y+4>IOSL)
- DO PRTC
- IF $DATA(DONE)
- QUIT
- DO HEAD
- +17 WRITE !," "_MSG,!
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 QUIT
- +19 ;
- HEAD ;
- +1 IF $Y>0
- WRITE @IOF
- SET PG=PG+1
- +2 WRITE " "_DATE,?71,"Page ",PG,!!
- +3 WRITE " Error log for PBM III national database processing.",!
- +4 WRITE " ---------------------------------------------------",!
- +5 QUIT
- +6 ;
- PRTC ;press return to continue prompt
- +1 IF $EXTRACT(IOST,1,2)'="C-"!($DATA(IO("S")))
- QUIT
- +2 KILL DIR
- WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET DONE=1
- +3 QUIT
- +4 ;
- +5 ;
