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

VAFHUTL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. LTD(DFN) ;
  1. ;This function will find the last time seen at the facility
  1. ;
  1. ; Input: DFN -- pointer to the patient in file #2
  1. ;
  1. ; Output: FileMan Date/time ^ I,D,R,A,S ^ HL7 Date/time ^ Variable PTR
  1. ;
  1. ; I = inpatient, D = discharge, R = Registration, A = Appointment
  1. ; S = Stop Code
  1. ;
  1. ; If Unsuccessful, Output: -1^error message
  1. ;
  1. N LTD,X,FLG,LAST,VARPTR
  1. ;
  1. S FLG=""
  1. ; - need a patient
  1. I '$G(DFN) Q "-1^Missing Parameters for LTD function"
  1. ;
  1. ; - if current inpatient, set LTD = today and quit
  1. 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
  1. ;
  1. ; - get the last discharge date
  1. S LTD=+$O(^DGPM("ATID3",DFN,"")) S:LTD FLG="D",LAST=9999999.9999999-LTD,LTD=LAST\1 S:LTD>DT (LAST,LTD)=DT
  1. ;
  1. ; - get the last registration date and compare to LTD
  1. 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("
  1. ;
  1. ; - get the last appointment and compare to LTD
  1. N SDDATE,SDARRAY,SDCLIEN,SDSTAT
  1. S SDDATE=LTD,SDARRAY("FLDS")=3,SDARRAY(4)=DFN
  1. I $$SDAPI^SDAMA301(.SDARRAY)>0 D
  1. .S SDCLIEN=0
  1. .F S SDCLIEN=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN)) Q:'SDCLIEN!(SDDATE>DT) D
  1. ..F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE)) Q:'SDDATE!(SDDATE>DT) D
  1. ...S SDSTAT=$P($P(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE),"^",3),";")
  1. ...I SDSTAT="R" D
  1. ....S LAST=SDDATE,LTD=SDDATE\1,FLG="A"
  1. ....I $D(VARPTR) K VARPTR
  1. K ^TMP($J,"SDAMA301")
  1. ;
  1. ; - get the last standalone after LTD
  1. S X=$$GETLAST^SDOE(DFN,LTD_".9999")
  1. I X S LAST=+$$SCE^DGSDU(X,1,0),LTD=LAST\1,FLG="S",VARPTR=X_";SCE("
  1. ;
  1. LTDQ I '$D(LAST) Q "-1^No last date"
  1. I '$D(VARPTR) S VARPTR=$$VPTR(FLG,DFN,LAST)
  1. I +VARPTR<1 Q "-1^No last date"
  1. Q LAST_"^"_FLG_"^"_$$HLDATE^HLFNC(LAST,"TS")_"^"_VARPTR
  1. ;
  1. ;
  1. VPTR(TYPE,DFN,EDATE) ;
  1. ;Gets pointer for inpatient/outpatient event
  1. ;
  1. I '$D(TYPE)!('$D(DFN))!('$D(EDATE)) Q "-1^Missing Parameters for VPTR function"
  1. N PTR,IND
  1. I TYPE'="A"&(TYPE'="D")&(TYPE'="I") Q "-1^NOT IN or OUT PATIENT"
  1. I TYPE="I"!(TYPE="D") D
  1. .;inpatient or discharge
  1. .S IND=$O(^DGPM("APID",DFN,"")),PTR=$O(^DGPM("APID",DFN,IND,""))
  1. .I $D(^DGPM(PTR)) S PTR="-1^MISSING ENTRY"
  1. .I +PTR>0 S PTR=PTR_";DGPM("
  1. I TYPE="A" D
  1. .;outpatient appointment
  1. .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("
  1. .I '$D(^SCE("ADFN",DFN,LAST)) S PTR=DFN_";DPT("
  1. Q PTR
  1. ;
  1. GETF(SEG) ;NOT USED ANY MORE
  1. ;This function will return all of the available fields for the SEG
  1. ;segment as found in the HL7 DHCP PARAMETER file, as a string,
  1. ;separated by commas
  1. ;
  1. ;Input: SEG - HL7 Segment
  1. ;Output: Successful - string of field numbers seperated by commas
  1. ;If unsuccessful, -1^error message will be returned.
  1. ;
  1. ;NOTE: HL("SAN") must be defined as Sending Application in file 771
  1. ;N ENT,FLDS
  1. ;I '$D(HLENTRY)!('$D(SEG)) Q "-1^MISSING PARAMETERS"
  1. ;do lookup in #771 for HLENTRY
  1. ;S DIC="^HL(770,",DIC(0)="MQZ",X=HLENTRY D ^DIC
  1. ;I +Y<0 Q "-1^NO ENTRY IN FILE 771"
  1. ;S ENT=$P(^HL(770,+Y,0),"^",8) I ENT="" Q "-1^NO ENTRY IN APPLICATION FIELD"
  1. ;
  1. N ENT,FLDS
  1. I $G(HL("SAN"))]"",$G(SEG)]""
  1. E Q "-1^MISSING PARAMETERS HL(SAN)!SEG"
  1. ;
  1. S ENT=$O(^HL(771,"B",HL("SAN"),0))
  1. I 'ENT Q "-1^NO ENTRY IN FILE 771"
  1. ;
  1. S DIC="^HL(771,ENT,""SEG"",",X=SEG,DIC(0)="MQZ" D ^DIC
  1. K DIC,X
  1. I +Y<0 K Y Q "-1^NO ENTRY IN SUBFILE #771.05"
  1. S FLDS=$P(^HL(771,ENT,"SEG",+Y,"F"),"^") K Y
  1. Q FLDS
  1. ;
  1. UPDATE(PIVOT,ADATE,APTR,REMOVE) ;
  1. ;
  1. ;This function will allow the updating of PIVOT number entry, updating
  1. ;EVENT DATE/TIME and the VARIABLE POINTER and setting of the DELETED
  1. ;field.
  1. ;
  1. ;Input: PIVOT - Pivot Number
  1. ; ADATE - Event Date/Time (new)
  1. ; APTR - Variable Pointer (new)
  1. ; REMOVE - 1 or null if 1 set DELETED field
  1. ;
  1. ;Output: 0 if successful
  1. ; -1^error message if not successful
  1. ;
  1. I '$D(PIVOT) Q "-1^MISSING PARAMETERS"
  1. I '$D(^VAT(391.71,"D",PIVOT)) Q "-1^NO PIVOT ENTRY"
  1. I '$D(REMOVE) S REMOVE=""
  1. I APTR?.N1";".A1"(" D
  1. .I $P(APTR,";",2)="DPT(" S APTR="P.`"_+APTR
  1. .I $P(APTR,";",2)="SCE(" S APTR="O.`"_+APTR
  1. .I $P(APTR,";",2)="DGMP(" S APTR="I.`"_+APTR
  1. S DA=$O(^VAT(391.71,"D",PIVOT,"")) I DA="" Q "-1^BAD CROSS REFERENCE"
  1. S DIE="^VAT(391.71,",DIC(0)="MQZ",DR=""
  1. I ADATE'="" S DR=DR_".01///"_ADATE_";"
  1. I APTR'="" S DR=DR_".05///"_APTR_";"
  1. S DR=DR_".07///"_REMOVE
  1. L +^VAT(391.71,DA,0):5
  1. I '$T Q "-1^Unable to lock entry in Pivot file"
  1. D ^DIE L -^VAT(391.71,DA,0)
  1. K DIE,DR,DIC,DA,X,Y
  1. Q 0
  1. ;
  1. SEND(VAR1) ;this function will test for the on/off parameter to send ADT messages.
  1. ;OUTPUTS 0 will indicate NOT to send
  1. ; 1 will indicate TO send
  1. ; 0 in second piece will indicate NOT to send HL7 v2.3
  1. ; 1 in second piece will indicate to send HL7 v2.3
  1. N VAR1
  1. S VAR1=$O(^DG(43,0))
  1. I +VAR1 S VAR1=$P($G(^DG(43,VAR1,"HL7")),"^",2,3)
  1. Q VAR1
  1. ;
  1. HLQ(DATA) ;this function returns the value passed to it or HLQ
  1. I $G(DATA)="" Q HLQ
  1. Q DATA
  1. ;
  1. NOSEND() ;function TURNS OFF the on/off parameter to send ADT messages.
  1. ; used by init to disable all ADT HL7 protocols
  1. ;
  1. ;OUTPUTS 1 will indicate it was SET NOT to send
  1. ; 0 will indicate it failed to SET IT NOT to send
  1. ;
  1. N VAR1
  1. S VAR1=$O(^DG(43,0))
  1. I +VAR1 S $P(^DG(43,+VAR1,"HL7"),"^",2,3)="0^0" Q 0
  1. Q 1
  1. ;
  1. DPROTO(PNAM) ;returns 0 if protocol disabled field is not null, ie disabled
  1. ; returns 1 if protocol is NOT disabled
  1. I $G(PNAM)]"",$P($G(^ORD(101,+$O(^ORD(101,"B",PNAM,0)),0)),"^",3)]"" Q 0
  1. Q 1