- RGADT2 ;HIRMFO/GJC-TFL FILE SEEDING ROUTINE (PD-MPI LOAD) ;09/21/99
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,17,20**;30 Apr 99
- Q ; quit if called from the top
- ;
- EN ; entry point to check the TREATING FACILITY LIST (TFL-391.91) file
- ; for the proper LAST TREATMENT DATE. This code is part of the post
- ; init for RG*1*4. This can also be called from the EN1 entry point
- ; to determine the LAST TREATMENT DATE for a specific patient.
- ; Closely linked to the MFU event message broadcasts used to update
- ; the TFL (#391.91) file.
- ;
- ;IA: 2053 - FILE^DIE
- ;IA: 2070 - check for national ICN, 1st piece "MPI" node (global read)
- ;IA: 2701 - $$IFLOCAL^MPIF001
- ;IA: 2546 - GETGEN/PARSE^SDOE
- ;IA: 2988 - FILE^VAFCTFU
- ;IA: 2541 - $$KSP^XUPARAM
- ;IA: 2953 - ^SCE("ADFN"
- ;IA: 10061 - IN5^VADPT
- ;IA: 10103 - $$FMDIFF/$$NOW^XLFDT
- ;IA: 10104 - $$STRIP^XLFSTR
- ;IA: 10070 - ^XMD
- ;IA: 10141 - $$PARCP/$$UPCP^XPDUTL
- ;
- Q:$P($G(^RGSITE(991.8,1,1)),"^",2) ; seeding process ran in the past
- ;
- S:$D(ZTQUEUED) ZTREQ="@"
- S U="^",RGSITE=$$KSP^XUPARAM("INST") ;defines the local facility
- S RGSTRT=$$NOW^XLFDT(),RGCNT=0
- ; check to see if software is part of an KIDS install. If not, no
- ; checkpoints needed.
- S RGICN=$S($D(XPDNM):+$$PARCP^XPDUTL("POST2"),1:0)
- ; check ALL patients with an Integration Control Number (ICN) for a
- ; given facility, make sure the DATE LAST TREATED field in the TFL
- ; file is correct.
- F S RGICN=$O(^DPT("AICN",RGICN)) Q:RGICN'>0 D
- . S RGDFN=0
- . F S RGDFN=$O(^DPT("AICN",RGICN,RGDFN)) Q:RGDFN'>0 D EN1(RGDFN)
- . S RGCNT=RGCNT+1 ; increment record counter
- . S:$D(XPDNM) RGSAVE=$$UPCP^XPDUTL("POST2",RGICN)
- . Q
- S RGFIN=$$NOW^XLFDT() D EMAIL^RGADT2 ; send completion message to user
- ; populate the 'MPI/PD SEEDING COMP DATE/TIME' (#12) field in the CIRN
- ; SITE PARAMETER FILE (#991.8) (do not re-seed a facility)
- K RGFDA S RGFDA(991.8,"1,",12)=$$NOW^XLFDT()
- D FILE^DIE("K","RGFDA"),KILL
- QUIT
- ;
- EN1(RGDFN,RGSUP) ; determine the LAST TREATMENT DATE for a single
- ; patient called from our seeding process above.
- ; input: RGDFN - the dfn of the patient
- ; RGSUP - if 1, suppress add entries to the ADT HL7 PIVOT
- ; (#391.71) file for TF messaging - VAFCTFMF (optional)
- ; output: RGDATE - patient's DATE LAST TREATED
- ; RGENVR - event reason
- ;
- Q:$$LOCICN(RGDFN,$G(RGICN)) ; local ICN
- S U="^"
- S RGSITE=$$KSP^XUPARAM("INST") ;defines the local facility
- S (RGLAST,RGADMDIS)=$$ADMDIS(RGDFN) ; dt_"^"_event type or ""
- S RGADMDIS=$S(RGADMDIS]"":$P(RGADMDIS,"^"),1:"") ; event dt or null
- S:$P(RGLAST,"^",2)=3!(RGLAST="") RGENCDT=$$ENCDT(RGDFN,RGADMDIS)
- ; patient has been discharged or has never been admitted. Has this
- ; individual been checked out of a clinic?
- I $D(RGENCDT)#2,($P(RGLAST,U)) S RGLAST=$S(+RGENCDT>+RGLAST:RGENCDT,1:RGLAST)
- I $D(RGENCDT)#2,('$P(RGLAST,U)) S RGLAST=RGENCDT
- S RGTYPE=$P(RGLAST,"^",2),RGDATE=+RGLAST
- ; input variables to FILE^VAFCTFU
- ; RGDFN - patient ien ; RGSITE - treating facility
- ; RGDATE - date last treated ; RGENVR - event reason
- ;
- I RGDATE D SETMSG,FILE^VAFCTFU(RGDFN,RGSITE_U_RGDATE_U_RGENVR,$G(RGSUP))
- ; update the TFL file for the site running the seeding process,
- ; then build the HL7 message with the new DATE LAST TREATED &
- ; ADT/HL7 EVENT REASON values & send them to our CMOR/subscribers.
- ;
- D:$G(XPDNM)'="RG*1.0*4" KILL ; single patient operation, kill all
- ; variables (EN1 re-entrant when running post-install for RG*1.0*4)
- Q
- ;
- KILL ; kill and quit
- K DFN,RGADMDIS,RGCNT,RGDATE,RGDFN,RGENCDT,RGENVR,RGFDA,RGFIN,RGICN
- K RGLAST,RGSAVE,RGSITE,RGSTRT,RGTYPE
- Q
- ;
- ADMDIS(DFN) ; find the patient's last admission and discharge dates if
- ; they exist.
- ; Input: DFN - ien of the patient (file 2)
- ;Output: a valid discharge/admission date/time concatenated with
- ; the event type (1=admission, 3=discharge) -or- null
- N %,VAERR,VAIP S VAIP("D")="LAST" D IN5^VADPT
- I '+$G(VAIP(17,1)),('+$G(VAIP(13,1))) Q ""
- ; no discharge date, no admission date, return null
- I '+$G(VAIP(17,1)) Q $P($G(VAIP(13,1)),U)_"^1"
- ; no discharge date, return admission date
- I '+$G(VAIP(13,1)) Q $P($G(VAIP(17,1)),U)_"^3"
- ; no admission date, return discharge date
- I +$G(VAIP(17,1))>(+$G(VAIP(13,1))) Q +$G(VAIP(17,1))_"^3"
- ; return discharge date
- Q +$G(VAIP(13,1))_"^1" ; return admission date
- ;
- ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN'
- ; cross-reference accessed through DBIA: 2953
- ; Input: DFN - ien of the patient (file 2)
- ; INPDT - date (if any) returned from the inpatient admission/
- ; discharge subroutine
- ;Output: a valid discharge/admission date/time concatenated with
- ; the event type (5=check out) -or- null
- Q:'DFN "" ; we need dfn defined
- K RGDATA,RGPURGE,RGX,RGX1,RGX2 N RGX3
- S RGX=9999999.9999999,RGX2=0,RGX3=""
- F S RGX=$O(^SCE("ADFN",DFN,RGX),-1) Q:'RGX!(INPDT>RGX) D Q:RGX2
- . S RGX1=0 F S RGX1=$O(^SCE("ADFN",DFN,RGX,RGX1)) Q:'RGX1 D Q:RGX2
- .. D GETGEN^SDOE(RGX1,"RGDATA")
- .. D PARSE^SDOE(.RGDATA,"EXTERNAL","RGPARSE")
- .. I $G(RGPARSE(.12))="CHECKED OUT" S RGX2=1,RGX3=RGX
- .. K RGDATA,RGPARSE
- .. Q
- . Q
- K RGDATA,RGPURGE,RGX,RGX1,RGX2
- Q RGX3_"^5" ; X is either null or the date/time of the check out
- ;
- SETMSG ; define the variables used to build a HL7 message (RGADT1)
- S DFN=RGDFN
- S RGENVR=$S(RGTYPE=1:"A1",RGTYPE=3:"A2",1:"A3") ;A1=adm;A2=dis;A3=CO
- Q
- ;
- EMAIL ; Send a completion email message to the user who installed this patch,
- ; RG*1*4. Show the number of records processed, elapsed time and the
- ; number of records processed per minute.
- N RGELAPS,RGARY,RGMIN
- S XMDUZ=.5,XMY(DUZ)="",XMTEXT="RGARY(1,"
- S XMSUB="CIRN-CPRS DATE LAST TREATED seeding (#391.91 ; .03) results"
- S RGMIN=$$FMDIFF^XLFDT(RGFIN,RGSTRT,2)/60 ; # of sec x (1 min/60 sec)
- S:RGMIN=0 RGMIN=1 ; avoid a possible divide by zero
- S RGELAPS=$$FMDIFF^XLFDT(RGFIN,RGSTRT,3)
- S RGARY(1,1)="# of processed patients, in the PATIENT (#2) file"
- S RGARY(1,2)="with an ICN: "_RGCNT
- S RGARY(1,3)="TFL seeding process run time: "_RGELAPS_" (DD HH:MM:SS format)"
- S RGARY(1,4)="# of records processed per minute: "_$$STRIP^XLFSTR($J((RGCNT/RGMIN),8,2)," ")
- D ^XMD K XMDUZ,XMSUB,XMTEXT,XMY
- Q
- ;
- LOCICN(DFN,ICN) ; check if this patient has a national ICN without having a
- ; local ICN. This function is used when an entire site (all patients)
- ; is seeding, or for individual patient seeding.
- ; note: IA 2070 covers the hit on the 'MPI' node
- ; IA 2701 covers the call to $$IFLOCAL^MPIF001
- ;input variables:
- ; DFN(required)-Patient ien (PATIENT file #2)
- ; ICN(optional)-Integration Control Number(fld: 991.01, file 2)
- ;output variable:
- ; FLAG-0 if the patient has a national ICN and not a local ICN, else 1
- N FLAG S FLAG=1
- I +$G(ICN) D
- . I $P($G(^DPT(DFN,"MPI")),"^")=ICN,('$$IFLOCAL^MPIF001(DFN)) S FLAG=0
- . Q
- E D
- . I $P($G(^DPT(DFN,"MPI")),"^"),('$$IFLOCAL^MPIF001(DFN)) S FLAG=0
- . Q
- Q FLAG
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGADT2 7079 printed Feb 18, 2025@23:07:45 Page 2
- RGADT2 ;HIRMFO/GJC-TFL FILE SEEDING ROUTINE (PD-MPI LOAD) ;09/21/99
- +1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,17,20**;30 Apr 99
- +2 ; quit if called from the top
- QUIT
- +3 ;
- EN ; entry point to check the TREATING FACILITY LIST (TFL-391.91) file
- +1 ; for the proper LAST TREATMENT DATE. This code is part of the post
- +2 ; init for RG*1*4. This can also be called from the EN1 entry point
- +3 ; to determine the LAST TREATMENT DATE for a specific patient.
- +4 ; Closely linked to the MFU event message broadcasts used to update
- +5 ; the TFL (#391.91) file.
- +6 ;
- +7 ;IA: 2053 - FILE^DIE
- +8 ;IA: 2070 - check for national ICN, 1st piece "MPI" node (global read)
- +9 ;IA: 2701 - $$IFLOCAL^MPIF001
- +10 ;IA: 2546 - GETGEN/PARSE^SDOE
- +11 ;IA: 2988 - FILE^VAFCTFU
- +12 ;IA: 2541 - $$KSP^XUPARAM
- +13 ;IA: 2953 - ^SCE("ADFN"
- +14 ;IA: 10061 - IN5^VADPT
- +15 ;IA: 10103 - $$FMDIFF/$$NOW^XLFDT
- +16 ;IA: 10104 - $$STRIP^XLFSTR
- +17 ;IA: 10070 - ^XMD
- +18 ;IA: 10141 - $$PARCP/$$UPCP^XPDUTL
- +19 ;
- +20 ; seeding process ran in the past
- if $PIECE($GET(^RGSITE(991.8,1,1)),"^",2)
- QUIT
- +21 ;
- +22 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +23 ;defines the local facility
- SET U="^"
- SET RGSITE=$$KSP^XUPARAM("INST")
- +24 SET RGSTRT=$$NOW^XLFDT()
- SET RGCNT=0
- +25 ; check to see if software is part of an KIDS install. If not, no
- +26 ; checkpoints needed.
- +27 SET RGICN=$SELECT($DATA(XPDNM):+$$PARCP^XPDUTL("POST2"),1:0)
- +28 ; check ALL patients with an Integration Control Number (ICN) for a
- +29 ; given facility, make sure the DATE LAST TREATED field in the TFL
- +30 ; file is correct.
- +31 FOR
- SET RGICN=$ORDER(^DPT("AICN",RGICN))
- if RGICN'>0
- QUIT
- Begin DoDot:1
- +32 SET RGDFN=0
- +33 FOR
- SET RGDFN=$ORDER(^DPT("AICN",RGICN,RGDFN))
- if RGDFN'>0
- QUIT
- DO EN1(RGDFN)
- +34 ; increment record counter
- SET RGCNT=RGCNT+1
- +35 if $DATA(XPDNM)
- SET RGSAVE=$$UPCP^XPDUTL("POST2",RGICN)
- +36 QUIT
- End DoDot:1
- +37 ; send completion message to user
- SET RGFIN=$$NOW^XLFDT()
- DO EMAIL^RGADT2
- +38 ; populate the 'MPI/PD SEEDING COMP DATE/TIME' (#12) field in the CIRN
- +39 ; SITE PARAMETER FILE (#991.8) (do not re-seed a facility)
- +40 KILL RGFDA
- SET RGFDA(991.8,"1,",12)=$$NOW^XLFDT()
- +41 DO FILE^DIE("K","RGFDA")
- DO KILL
- +42 QUIT
- +43 ;
- EN1(RGDFN,RGSUP) ; determine the LAST TREATMENT DATE for a single
- +1 ; patient called from our seeding process above.
- +2 ; input: RGDFN - the dfn of the patient
- +3 ; RGSUP - if 1, suppress add entries to the ADT HL7 PIVOT
- +4 ; (#391.71) file for TF messaging - VAFCTFMF (optional)
- +5 ; output: RGDATE - patient's DATE LAST TREATED
- +6 ; RGENVR - event reason
- +7 ;
- +8 ; local ICN
- if $$LOCICN(RGDFN,$GET(RGICN))
- QUIT
- +9 SET U="^"
- +10 ;defines the local facility
- SET RGSITE=$$KSP^XUPARAM("INST")
- +11 ; dt_"^"_event type or ""
- SET (RGLAST,RGADMDIS)=$$ADMDIS(RGDFN)
- +12 ; event dt or null
- SET RGADMDIS=$SELECT(RGADMDIS]"":$PIECE(RGADMDIS,"^"),1:"")
- +13 if $PIECE(RGLAST,"^",2)=3!(RGLAST="")
- SET RGENCDT=$$ENCDT(RGDFN,RGADMDIS)
- +14 ; patient has been discharged or has never been admitted. Has this
- +15 ; individual been checked out of a clinic?
- +16 IF $DATA(RGENCDT)#2
- IF ($PIECE(RGLAST,U))
- SET RGLAST=$SELECT(+RGENCDT>+RGLAST:RGENCDT,1:RGLAST)
- +17 IF $DATA(RGENCDT)#2
- IF ('$PIECE(RGLAST,U))
- SET RGLAST=RGENCDT
- +18 SET RGTYPE=$PIECE(RGLAST,"^",2)
- SET RGDATE=+RGLAST
- +19 ; input variables to FILE^VAFCTFU
- +20 ; RGDFN - patient ien ; RGSITE - treating facility
- +21 ; RGDATE - date last treated ; RGENVR - event reason
- +22 ;
- +23 IF RGDATE
- DO SETMSG
- DO FILE^VAFCTFU(RGDFN,RGSITE_U_RGDATE_U_RGENVR,$GET(RGSUP))
- +24 ; update the TFL file for the site running the seeding process,
- +25 ; then build the HL7 message with the new DATE LAST TREATED &
- +26 ; ADT/HL7 EVENT REASON values & send them to our CMOR/subscribers.
- +27 ;
- +28 ; single patient operation, kill all
- if $GET(XPDNM)'="RG*1.0*4"
- DO KILL
- +29 ; variables (EN1 re-entrant when running post-install for RG*1.0*4)
- +30 QUIT
- +31 ;
- KILL ; kill and quit
- +1 KILL DFN,RGADMDIS,RGCNT,RGDATE,RGDFN,RGENCDT,RGENVR,RGFDA,RGFIN,RGICN
- +2 KILL RGLAST,RGSAVE,RGSITE,RGSTRT,RGTYPE
- +3 QUIT
- +4 ;
- ADMDIS(DFN) ; find the patient's last admission and discharge dates if
- +1 ; they exist.
- +2 ; Input: DFN - ien of the patient (file 2)
- +3 ;Output: a valid discharge/admission date/time concatenated with
- +4 ; the event type (1=admission, 3=discharge) -or- null
- +5 NEW %,VAERR,VAIP
- SET VAIP("D")="LAST"
- DO IN5^VADPT
- +6 IF '+$GET(VAIP(17,1))
- IF ('+$GET(VAIP(13,1)))
- QUIT ""
- +7 ; no discharge date, no admission date, return null
- +8 IF '+$GET(VAIP(17,1))
- QUIT $PIECE($GET(VAIP(13,1)),U)_"^1"
- +9 ; no discharge date, return admission date
- +10 IF '+$GET(VAIP(13,1))
- QUIT $PIECE($GET(VAIP(17,1)),U)_"^3"
- +11 ; no admission date, return discharge date
- +12 IF +$GET(VAIP(17,1))>(+$GET(VAIP(13,1)))
- QUIT +$GET(VAIP(17,1))_"^3"
- +13 ; return discharge date
- +14 ; return admission date
- QUIT +$GET(VAIP(13,1))_"^1"
- +15 ;
- ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN'
- +1 ; cross-reference accessed through DBIA: 2953
- +2 ; Input: DFN - ien of the patient (file 2)
- +3 ; INPDT - date (if any) returned from the inpatient admission/
- +4 ; discharge subroutine
- +5 ;Output: a valid discharge/admission date/time concatenated with
- +6 ; the event type (5=check out) -or- null
- +7 ; we need dfn defined
- if 'DFN
- QUIT ""
- +8 KILL RGDATA,RGPURGE,RGX,RGX1,RGX2
- NEW RGX3
- +9 SET RGX=9999999.9999999
- SET RGX2=0
- SET RGX3=""
- +10 FOR
- SET RGX=$ORDER(^SCE("ADFN",DFN,RGX),-1)
- if 'RGX!(INPDT>RGX)
- QUIT
- Begin DoDot:1
- +11 SET RGX1=0
- FOR
- SET RGX1=$ORDER(^SCE("ADFN",DFN,RGX,RGX1))
- if 'RGX1
- QUIT
- Begin DoDot:2
- +12 DO GETGEN^SDOE(RGX1,"RGDATA")
- +13 DO PARSE^SDOE(.RGDATA,"EXTERNAL","RGPARSE")
- +14 IF $GET(RGPARSE(.12))="CHECKED OUT"
- SET RGX2=1
- SET RGX3=RGX
- +15 KILL RGDATA,RGPARSE
- +16 QUIT
- End DoDot:2
- if RGX2
- QUIT
- +17 QUIT
- End DoDot:1
- if RGX2
- QUIT
- +18 KILL RGDATA,RGPURGE,RGX,RGX1,RGX2
- +19 ; X is either null or the date/time of the check out
- QUIT RGX3_"^5"
- +20 ;
- SETMSG ; define the variables used to build a HL7 message (RGADT1)
- +1 SET DFN=RGDFN
- +2 ;A1=adm;A2=dis;A3=CO
- SET RGENVR=$SELECT(RGTYPE=1:"A1",RGTYPE=3:"A2",1:"A3")
- +3 QUIT
- +4 ;
- EMAIL ; Send a completion email message to the user who installed this patch,
- +1 ; RG*1*4. Show the number of records processed, elapsed time and the
- +2 ; number of records processed per minute.
- +3 NEW RGELAPS,RGARY,RGMIN
- +4 SET XMDUZ=.5
- SET XMY(DUZ)=""
- SET XMTEXT="RGARY(1,"
- +5 SET XMSUB="CIRN-CPRS DATE LAST TREATED seeding (#391.91 ; .03) results"
- +6 ; # of sec x (1 min/60 sec)
- SET RGMIN=$$FMDIFF^XLFDT(RGFIN,RGSTRT,2)/60
- +7 ; avoid a possible divide by zero
- if RGMIN=0
- SET RGMIN=1
- +8 SET RGELAPS=$$FMDIFF^XLFDT(RGFIN,RGSTRT,3)
- +9 SET RGARY(1,1)="# of processed patients, in the PATIENT (#2) file"
- +10 SET RGARY(1,2)="with an ICN: "_RGCNT
- +11 SET RGARY(1,3)="TFL seeding process run time: "_RGELAPS_" (DD HH:MM:SS format)"
- +12 SET RGARY(1,4)="# of records processed per minute: "_$$STRIP^XLFSTR($JUSTIFY((RGCNT/RGMIN),8,2)," ")
- +13 DO ^XMD
- KILL XMDUZ,XMSUB,XMTEXT,XMY
- +14 QUIT
- +15 ;
- LOCICN(DFN,ICN) ; check if this patient has a national ICN without having a
- +1 ; local ICN. This function is used when an entire site (all patients)
- +2 ; is seeding, or for individual patient seeding.
- +3 ; note: IA 2070 covers the hit on the 'MPI' node
- +4 ; IA 2701 covers the call to $$IFLOCAL^MPIF001
- +5 ;input variables:
- +6 ; DFN(required)-Patient ien (PATIENT file #2)
- +7 ; ICN(optional)-Integration Control Number(fld: 991.01, file 2)
- +8 ;output variable:
- +9 ; FLAG-0 if the patient has a national ICN and not a local ICN, else 1
- +10 NEW FLAG
- SET FLAG=1
- +11 IF +$GET(ICN)
- Begin DoDot:1
- +12 IF $PIECE($GET(^DPT(DFN,"MPI")),"^")=ICN
- IF ('$$IFLOCAL^MPIF001(DFN))
- SET FLAG=0
- +13 QUIT
- End DoDot:1
- +14 IF '$TEST
- Begin DoDot:1
- +15 IF $PIECE($GET(^DPT(DFN,"MPI")),"^")
- IF ('$$IFLOCAL^MPIF001(DFN))
- SET FLAG=0
- +16 QUIT
- End DoDot:1
- +17 QUIT FLAG