- VAFHUTL ;ALB/CM/PHH/EG/GAH UTILITIES ROUTINE ; 10/18/06
- ;;5.3;Registration;**91,151,568,585,725**;Jun 06, 1996;Build 12
- ;
- ;
- LTD(DFN) ;
- ;This function will find the last time seen at the facility
- ;
- ; Input: DFN -- pointer to the patient in file #2
- ;
- ; Output: FileMan Date/time ^ I,D,R,A,S ^ HL7 Date/time ^ Variable PTR
- ;
- ; I = inpatient, D = discharge, R = Registration, A = Appointment
- ; S = Stop Code
- ;
- ; If Unsuccessful, Output: -1^error message
- ;
- N LTD,X,FLG,LAST,VARPTR
- ;
- S FLG=""
- ; - need a patient
- I '$G(DFN) Q "-1^Missing Parameters for LTD function"
- ;
- ; - if current inpatient, set LTD = today and quit
- I $G(^DPT(DFN,.105)) S LTD=DT,FLG="I" I $D(^DGPM("ATID1",DFN)) S LAST=9999999.9999999-($O(^DGPM("ATID1",DFN,""))) G LTDQ
- ;
- ; - get the last discharge date
- S LTD=+$O(^DGPM("ATID3",DFN,"")) S:LTD FLG="D",LAST=9999999.9999999-LTD,LTD=LAST\1 S:LTD>DT (LAST,LTD)=DT
- ;
- ; - get the last registration date and compare to LTD
- S X=+$O(^DPT(DFN,"DIS",0)) I X S X=9999999-X S:(X\1)>LTD LAST=X,LTD=X\1,FLG="R",VARPTR=DFN_";DPT("
- ;
- ; - get the last appointment and compare to LTD
- N SDDATE,SDARRAY,SDCLIEN,SDSTAT
- S SDDATE=LTD,SDARRAY("FLDS")=3,SDARRAY(4)=DFN
- I $$SDAPI^SDAMA301(.SDARRAY)>0 D
- .S SDCLIEN=0
- .F S SDCLIEN=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN)) Q:'SDCLIEN!(SDDATE>DT) D
- ..F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE)) Q:'SDDATE!(SDDATE>DT) D
- ...S SDSTAT=$P($P(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE),"^",3),";")
- ...I SDSTAT="R" D
- ....S LAST=SDDATE,LTD=SDDATE\1,FLG="A"
- ....I $D(VARPTR) K VARPTR
- K ^TMP($J,"SDAMA301")
- ;
- ; - get the last standalone after LTD
- S X=$$GETLAST^SDOE(DFN,LTD_".9999")
- I X S LAST=+$$SCE^DGSDU(X,1,0),LTD=LAST\1,FLG="S",VARPTR=X_";SCE("
- ;
- LTDQ I '$D(LAST) Q "-1^No last date"
- I '$D(VARPTR) S VARPTR=$$VPTR(FLG,DFN,LAST)
- I +VARPTR<1 Q "-1^No last date"
- Q LAST_"^"_FLG_"^"_$$HLDATE^HLFNC(LAST,"TS")_"^"_VARPTR
- ;
- ;
- VPTR(TYPE,DFN,EDATE) ;
- ;Gets pointer for inpatient/outpatient event
- ;
- I '$D(TYPE)!('$D(DFN))!('$D(EDATE)) Q "-1^Missing Parameters for VPTR function"
- N PTR,IND
- I TYPE'="A"&(TYPE'="D")&(TYPE'="I") Q "-1^NOT IN or OUT PATIENT"
- I TYPE="I"!(TYPE="D") D
- .;inpatient or discharge
- .S IND=$O(^DGPM("APID",DFN,"")),PTR=$O(^DGPM("APID",DFN,IND,""))
- .I $D(^DGPM(PTR)) S PTR="-1^MISSING ENTRY"
- .I +PTR>0 S PTR=PTR_";DGPM("
- I TYPE="A" D
- .;outpatient appointment
- .I $D(^SCE("ADFN",DFN,LAST)) S PTR=$O(^SCE("ADFN",DFN,LAST,"")) S:('$D(^SCE(+PTR,0))) PTR=DFN_";DPT(" S:($D(^SCE(+PTR,0))) PTR=PTR_";SCE("
- .I '$D(^SCE("ADFN",DFN,LAST)) S PTR=DFN_";DPT("
- Q PTR
- ;
- GETF(SEG) ;NOT USED ANY MORE
- ;This function will return all of the available fields for the SEG
- ;segment as found in the HL7 DHCP PARAMETER file, as a string,
- ;separated by commas
- ;
- ;Input: SEG - HL7 Segment
- ;Output: Successful - string of field numbers seperated by commas
- ;If unsuccessful, -1^error message will be returned.
- ;
- ;NOTE: HL("SAN") must be defined as Sending Application in file 771
- ;N ENT,FLDS
- ;I '$D(HLENTRY)!('$D(SEG)) Q "-1^MISSING PARAMETERS"
- ;do lookup in #771 for HLENTRY
- ;S DIC="^HL(770,",DIC(0)="MQZ",X=HLENTRY D ^DIC
- ;I +Y<0 Q "-1^NO ENTRY IN FILE 771"
- ;S ENT=$P(^HL(770,+Y,0),"^",8) I ENT="" Q "-1^NO ENTRY IN APPLICATION FIELD"
- ;
- N ENT,FLDS
- I $G(HL("SAN"))]"",$G(SEG)]""
- E Q "-1^MISSING PARAMETERS HL(SAN)!SEG"
- ;
- S ENT=$O(^HL(771,"B",HL("SAN"),0))
- I 'ENT Q "-1^NO ENTRY IN FILE 771"
- ;
- S DIC="^HL(771,ENT,""SEG"",",X=SEG,DIC(0)="MQZ" D ^DIC
- K DIC,X
- I +Y<0 K Y Q "-1^NO ENTRY IN SUBFILE #771.05"
- S FLDS=$P(^HL(771,ENT,"SEG",+Y,"F"),"^") K Y
- Q FLDS
- ;
- UPDATE(PIVOT,ADATE,APTR,REMOVE) ;
- ;
- ;This function will allow the updating of PIVOT number entry, updating
- ;EVENT DATE/TIME and the VARIABLE POINTER and setting of the DELETED
- ;field.
- ;
- ;Input: PIVOT - Pivot Number
- ; ADATE - Event Date/Time (new)
- ; APTR - Variable Pointer (new)
- ; REMOVE - 1 or null if 1 set DELETED field
- ;
- ;Output: 0 if successful
- ; -1^error message if not successful
- ;
- I '$D(PIVOT) Q "-1^MISSING PARAMETERS"
- I '$D(^VAT(391.71,"D",PIVOT)) Q "-1^NO PIVOT ENTRY"
- I '$D(REMOVE) S REMOVE=""
- I APTR?.N1";".A1"(" D
- .I $P(APTR,";",2)="DPT(" S APTR="P.`"_+APTR
- .I $P(APTR,";",2)="SCE(" S APTR="O.`"_+APTR
- .I $P(APTR,";",2)="DGMP(" S APTR="I.`"_+APTR
- S DA=$O(^VAT(391.71,"D",PIVOT,"")) I DA="" Q "-1^BAD CROSS REFERENCE"
- S DIE="^VAT(391.71,",DIC(0)="MQZ",DR=""
- I ADATE'="" S DR=DR_".01///"_ADATE_";"
- I APTR'="" S DR=DR_".05///"_APTR_";"
- S DR=DR_".07///"_REMOVE
- L +^VAT(391.71,DA,0):5
- I '$T Q "-1^Unable to lock entry in Pivot file"
- D ^DIE L -^VAT(391.71,DA,0)
- K DIE,DR,DIC,DA,X,Y
- Q 0
- ;
- SEND(VAR1) ;this function will test for the on/off parameter to send ADT messages.
- ;OUTPUTS 0 will indicate NOT to send
- ; 1 will indicate TO send
- ; 0 in second piece will indicate NOT to send HL7 v2.3
- ; 1 in second piece will indicate to send HL7 v2.3
- N VAR1
- S VAR1=$O(^DG(43,0))
- I +VAR1 S VAR1=$P($G(^DG(43,VAR1,"HL7")),"^",2,3)
- Q VAR1
- ;
- HLQ(DATA) ;this function returns the value passed to it or HLQ
- I $G(DATA)="" Q HLQ
- Q DATA
- ;
- NOSEND() ;function TURNS OFF the on/off parameter to send ADT messages.
- ; used by init to disable all ADT HL7 protocols
- ;
- ;OUTPUTS 1 will indicate it was SET NOT to send
- ; 0 will indicate it failed to SET IT NOT to send
- ;
- N VAR1
- S VAR1=$O(^DG(43,0))
- I +VAR1 S $P(^DG(43,+VAR1,"HL7"),"^",2,3)="0^0" Q 0
- Q 1
- ;
- DPROTO(PNAM) ;returns 0 if protocol disabled field is not null, ie disabled
- ; returns 1 if protocol is NOT disabled
- I $G(PNAM)]"",$P($G(^ORD(101,+$O(^ORD(101,"B",PNAM,0)),0)),"^",3)]"" Q 0
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHUTL 5813 printed Jan 18, 2025@04:04:32 Page 2
- VAFHUTL ;ALB/CM/PHH/EG/GAH UTILITIES ROUTINE ; 10/18/06
- +1 ;;5.3;Registration;**91,151,568,585,725**;Jun 06, 1996;Build 12
- +2 ;
- +3 ;
- LTD(DFN) ;
- +1 ;This function will find the last time seen at the facility
- +2 ;
- +3 ; Input: DFN -- pointer to the patient in file #2
- +4 ;
- +5 ; Output: FileMan Date/time ^ I,D,R,A,S ^ HL7 Date/time ^ Variable PTR
- +6 ;
- +7 ; I = inpatient, D = discharge, R = Registration, A = Appointment
- +8 ; S = Stop Code
- +9 ;
- +10 ; If Unsuccessful, Output: -1^error message
- +11 ;
- +12 NEW LTD,X,FLG,LAST,VARPTR
- +13 ;
- +14 SET FLG=""
- +15 ; - need a patient
- +16 IF '$GET(DFN)
- QUIT "-1^Missing Parameters for LTD function"
- +17 ;
- +18 ; - if current inpatient, set LTD = today and quit
- +19 IF $GET(^DPT(DFN,.105))
- SET LTD=DT
- SET FLG="I"
- IF $DATA(^DGPM("ATID1",DFN))
- SET LAST=9999999.9999999-($ORDER(^DGPM("ATID1",DFN,"")))
- GOTO LTDQ
- +20 ;
- +21 ; - get the last discharge date
- +22 SET LTD=+$ORDER(^DGPM("ATID3",DFN,""))
- if LTD
- SET FLG="D"
- SET LAST=9999999.9999999-LTD
- SET LTD=LAST\1
- if LTD>DT
- SET (LAST,LTD)=DT
- +23 ;
- +24 ; - get the last registration date and compare to LTD
- +25 SET X=+$ORDER(^DPT(DFN,"DIS",0))
- IF X
- SET X=9999999-X
- if (X\1)>LTD
- SET LAST=X
- SET LTD=X\1
- SET FLG="R"
- SET VARPTR=DFN_";DPT("
- +26 ;
- +27 ; - get the last appointment and compare to LTD
- +28 NEW SDDATE,SDARRAY,SDCLIEN,SDSTAT
- +29 SET SDDATE=LTD
- SET SDARRAY("FLDS")=3
- SET SDARRAY(4)=DFN
- +30 IF $$SDAPI^SDAMA301(.SDARRAY)>0
- Begin DoDot:1
- +31 SET SDCLIEN=0
- +32 FOR
- SET SDCLIEN=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDCLIEN))
- if 'SDCLIEN!(SDDATE>DT)
- QUIT
- Begin DoDot:2
- +33 FOR
- SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDCLIEN,SDDATE))
- if 'SDDATE!(SDDATE>DT)
- QUIT
- Begin DoDot:3
- +34 SET SDSTAT=$PIECE($PIECE(^TMP($JOB,"SDAMA301",DFN,SDCLIEN,SDDATE),"^",3),";")
- +35 IF SDSTAT="R"
- Begin DoDot:4
- +36 SET LAST=SDDATE
- SET LTD=SDDATE\1
- SET FLG="A"
- +37 IF $DATA(VARPTR)
- KILL VARPTR
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +38 KILL ^TMP($JOB,"SDAMA301")
- +39 ;
- +40 ; - get the last standalone after LTD
- +41 SET X=$$GETLAST^SDOE(DFN,LTD_".9999")
- +42 IF X
- SET LAST=+$$SCE^DGSDU(X,1,0)
- SET LTD=LAST\1
- SET FLG="S"
- SET VARPTR=X_";SCE("
- +43 ;
- LTDQ IF '$DATA(LAST)
- QUIT "-1^No last date"
- +1 IF '$DATA(VARPTR)
- SET VARPTR=$$VPTR(FLG,DFN,LAST)
- +2 IF +VARPTR<1
- QUIT "-1^No last date"
- +3 QUIT LAST_"^"_FLG_"^"_$$HLDATE^HLFNC(LAST,"TS")_"^"_VARPTR
- +4 ;
- +5 ;
- VPTR(TYPE,DFN,EDATE) ;
- +1 ;Gets pointer for inpatient/outpatient event
- +2 ;
- +3 IF '$DATA(TYPE)!('$DATA(DFN))!('$DATA(EDATE))
- QUIT "-1^Missing Parameters for VPTR function"
- +4 NEW PTR,IND
- +5 IF TYPE'="A"&(TYPE'="D")&(TYPE'="I")
- QUIT "-1^NOT IN or OUT PATIENT"
- +6 IF TYPE="I"!(TYPE="D")
- Begin DoDot:1
- +7 ;inpatient or discharge
- +8 SET IND=$ORDER(^DGPM("APID",DFN,""))
- SET PTR=$ORDER(^DGPM("APID",DFN,IND,""))
- +9 IF $DATA(^DGPM(PTR))
- SET PTR="-1^MISSING ENTRY"
- +10 IF +PTR>0
- SET PTR=PTR_";DGPM("
- End DoDot:1
- +11 IF TYPE="A"
- Begin DoDot:1
- +12 ;outpatient appointment
- +13 IF $DATA(^SCE("ADFN",DFN,LAST))
- SET PTR=$ORDER(^SCE("ADFN",DFN,LAST,""))
- if ('$DATA(^SCE(+PTR,0)))
- SET PTR=DFN_";DPT("
- if ($DATA(^SCE(+PTR,0)))
- SET PTR=PTR_";SCE("
- +14 IF '$DATA(^SCE("ADFN",DFN,LAST))
- SET PTR=DFN_";DPT("
- End DoDot:1
- +15 QUIT PTR
- +16 ;
- GETF(SEG) ;NOT USED ANY MORE
- +1 ;This function will return all of the available fields for the SEG
- +2 ;segment as found in the HL7 DHCP PARAMETER file, as a string,
- +3 ;separated by commas
- +4 ;
- +5 ;Input: SEG - HL7 Segment
- +6 ;Output: Successful - string of field numbers seperated by commas
- +7 ;If unsuccessful, -1^error message will be returned.
- +8 ;
- +9 ;NOTE: HL("SAN") must be defined as Sending Application in file 771
- +10 ;N ENT,FLDS
- +11 ;I '$D(HLENTRY)!('$D(SEG)) Q "-1^MISSING PARAMETERS"
- +12 ;do lookup in #771 for HLENTRY
- +13 ;S DIC="^HL(770,",DIC(0)="MQZ",X=HLENTRY D ^DIC
- +14 ;I +Y<0 Q "-1^NO ENTRY IN FILE 771"
- +15 ;S ENT=$P(^HL(770,+Y,0),"^",8) I ENT="" Q "-1^NO ENTRY IN APPLICATION FIELD"
- +16 ;
- +17 NEW ENT,FLDS
- +18 IF $GET(HL("SAN"))]""
- IF $GET(SEG)]""
- +19 IF '$TEST
- QUIT "-1^MISSING PARAMETERS HL(SAN)!SEG"
- +20 ;
- +21 SET ENT=$ORDER(^HL(771,"B",HL("SAN"),0))
- +22 IF 'ENT
- QUIT "-1^NO ENTRY IN FILE 771"
- +23 ;
- +24 SET DIC="^HL(771,ENT,""SEG"","
- SET X=SEG
- SET DIC(0)="MQZ"
- DO ^DIC
- +25 KILL DIC,X
- +26 IF +Y<0
- KILL Y
- QUIT "-1^NO ENTRY IN SUBFILE #771.05"
- +27 SET FLDS=$PIECE(^HL(771,ENT,"SEG",+Y,"F"),"^")
- KILL Y
- +28 QUIT FLDS
- +29 ;
- UPDATE(PIVOT,ADATE,APTR,REMOVE) ;
- +1 ;
- +2 ;This function will allow the updating of PIVOT number entry, updating
- +3 ;EVENT DATE/TIME and the VARIABLE POINTER and setting of the DELETED
- +4 ;field.
- +5 ;
- +6 ;Input: PIVOT - Pivot Number
- +7 ; ADATE - Event Date/Time (new)
- +8 ; APTR - Variable Pointer (new)
- +9 ; REMOVE - 1 or null if 1 set DELETED field
- +10 ;
- +11 ;Output: 0 if successful
- +12 ; -1^error message if not successful
- +13 ;
- +14 IF '$DATA(PIVOT)
- QUIT "-1^MISSING PARAMETERS"
- +15 IF '$DATA(^VAT(391.71,"D",PIVOT))
- QUIT "-1^NO PIVOT ENTRY"
- +16 IF '$DATA(REMOVE)
- SET REMOVE=""
- +17 IF APTR?.N1";".A1"("
- Begin DoDot:1
- +18 IF $PIECE(APTR,";",2)="DPT("
- SET APTR="P.`"_+APTR
- +19 IF $PIECE(APTR,";",2)="SCE("
- SET APTR="O.`"_+APTR
- +20 IF $PIECE(APTR,";",2)="DGMP("
- SET APTR="I.`"_+APTR
- End DoDot:1
- +21 SET DA=$ORDER(^VAT(391.71,"D",PIVOT,""))
- IF DA=""
- QUIT "-1^BAD CROSS REFERENCE"
- +22 SET DIE="^VAT(391.71,"
- SET DIC(0)="MQZ"
- SET DR=""
- +23 IF ADATE'=""
- SET DR=DR_".01///"_ADATE_";"
- +24 IF APTR'=""
- SET DR=DR_".05///"_APTR_";"
- +25 SET DR=DR_".07///"_REMOVE
- +26 LOCK +^VAT(391.71,DA,0):5
- +27 IF '$TEST
- QUIT "-1^Unable to lock entry in Pivot file"
- +28 DO ^DIE
- LOCK -^VAT(391.71,DA,0)
- +29 KILL DIE,DR,DIC,DA,X,Y
- +30 QUIT 0
- +31 ;
- SEND(VAR1) ;this function will test for the on/off parameter to send ADT messages.
- +1 ;OUTPUTS 0 will indicate NOT to send
- +2 ; 1 will indicate TO send
- +3 ; 0 in second piece will indicate NOT to send HL7 v2.3
- +4 ; 1 in second piece will indicate to send HL7 v2.3
- +5 NEW VAR1
- +6 SET VAR1=$ORDER(^DG(43,0))
- +7 IF +VAR1
- SET VAR1=$PIECE($GET(^DG(43,VAR1,"HL7")),"^",2,3)
- +8 QUIT VAR1
- +9 ;
- HLQ(DATA) ;this function returns the value passed to it or HLQ
- +1 IF $GET(DATA)=""
- QUIT HLQ
- +2 QUIT DATA
- +3 ;
- NOSEND() ;function TURNS OFF the on/off parameter to send ADT messages.
- +1 ; used by init to disable all ADT HL7 protocols
- +2 ;
- +3 ;OUTPUTS 1 will indicate it was SET NOT to send
- +4 ; 0 will indicate it failed to SET IT NOT to send
- +5 ;
- +6 NEW VAR1
- +7 SET VAR1=$ORDER(^DG(43,0))
- +8 IF +VAR1
- SET $PIECE(^DG(43,+VAR1,"HL7"),"^",2,3)="0^0"
- QUIT 0
- +9 QUIT 1
- +10 ;
- DPROTO(PNAM) ;returns 0 if protocol disabled field is not null, ie disabled
- +1 ; returns 1 if protocol is NOT disabled
- +2 IF $GET(PNAM)]""
- IF $PIECE($GET(^ORD(101,+$ORDER(^ORD(101,"B",PNAM,0)),0)),"^",3)]""
- QUIT 0
- +3 QUIT 1