SDTMPHLB ;MS/PB - TMP HL7 Routine;MAY 29, 2018
;;5.3;Scheduling;**704,733,714,773,888**;AUG 13, 1993;Build 8
Q
EN(CLINID) ; Entry to the routine to build an HL7 message
;notification to TMP about a new appointment in a TeleHealth Clinic
;put in check for this to be a telehealth clinic. if not a telehealth clinic quit
;Call API to create MSH segment
;
;need to parse data from the file based on clinic, need to get VISN, overbooks and clinic status and privileged users
;default provider and default provider email.
N STOP,SSTOP,PSTOP,MSG,RTN,UPDTTM
S PSTOP=$P(^SC(CLINID,0),"^",7),SSTOP=$P(^SC(CLINID,0),"^",18)
I ($G(PSTOP)=""&($G(SSTOP)="")) Q 0 ;if both PSTOP and SSTOP are null, the clinic is not a tele health clinic so quit
S:$G(PSTOP)'="" STOP=$$CHKCLIN^SDTMPHLA($G(PSTOP)) ;if STOP=0, primary stop code is not a tele health stop code so check secondary stop code to see if it is a tele health clinic
;I $G(STOP)=0,($$CHKCLIN^SDTMPHLA($G(SSTOP))'="") Q ;if primary stop code is not tele health check secondary stop code if secondary not tele health stop
I $G(STOP)=0 Q:$G(SSTOP)'>0 S STOP=$$CHKCLIN^SDTMPHLA(SSTOP) ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop
Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic
N PARMS,SEG,WHOTO,ERROR,SEQ
S PARMS("MESSAGE TYPE")="MFN",PARMS("EVENT")="M05"
I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) W !,"ERR= "_$G(ERROR) Q 0
S SEQ=1
N % D NOW^%DTC S UPDTTM=$$TMCONV^SDTMPHLA(%,$$INST^SDTMPHLA(CLINID))
K CLIN,IEN S IEN=CLINID_"," D CLINDATA(IEN)
D MFI(CLINID,SEQ,.SEG)
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) W !,"NOT ADDED "_$G(ERROR)_" " Q 0
D MFE(CLINID,SEQ,.SEG)
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
D LOC(CLINID,SEQ,.SEG)
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
D NTE(CLINID,SEQ,.SEG)
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
D LDP(CLINID,SEQ,.SEG)
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
D ZDP(CLINID,SEQ,.SEG)
I $D(SEG),'$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
D ZPU(CLINID,SEQ,.SEG)
S PARMS("SENDING APPLICATION")="TMP_OUT"
S WHOTO("RECEIVING APPLICATION")="TMP VIMT"
S WHOTO("FACILITY LINK NAME")="TMP_SEND"
S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0))
S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
K CLINID,LOC
Q RTN
MFI(CLINID,SEQ,SEG) ;
N APPID
D SET^HLOAPI(.SEG,"MFI",0) ; Set the segment type
;D SET^HLOAPI(.SEG,"MFI",0) ; Set segment type to MFI
D SET^HLOAPI(.SEG,CLINID,1) ; Set CLINIC ID
S APPID="44^HOSPITAL LOCATION"
D SET^HLOAPI(.SEG,APPID,2) ; File to be updated
D SET^HLOAPI(.SEG,"UPD",3) ; Hard set as an UPD to the file -- Need code to determine if new or update
D SET^HLOAPI(.SEG,UPDTTM,4) ; date/time the update occurred
D SET^HLOAPI(.SEG,UPDTTM,5) ; effective date/time
D SET^HLOAPI(.SEG,"AL",6) ; response level code, this is set to AL for ALWAYS
Q
MFE(CLINID,SEQ,SEG) ;
N TYPE
D SET^HLOAPI(.SEG,"MFE",0) ; Set the segment type
S TYPE="MUP" ; this will be MAD for adding a new clinic, MUP for an update, MDS do deactivate and MAC for reactivate
D SET^HLOAPI(.SEG,TYPE,1) ; type of action
D SET^HLOAPI(.SEG,CLINID,2) ; Clinic IEN from the Hospital Location file
D SET^HLOAPI(.SEG,UPDTTM,3)
D SET^HLOAPI(.SEG,CLINID,4)
D SET^HLOAPI(.SEG,"CE",5) ; Primary key value type, this will always be CE
Q
LOC(CLINID,SEQ,SEG) ;
N INSTNUM,VISN,STATNUM,CLINNM,DIV,DIV1,DIV2,DIV3
K LOC
S CLINNM=CLIN(44,CLINID_",",.01,"E"),STATNUM=$G(CLIN(44,CLINID_",",3,"I"))
;Patch 714 PB - 11/07/19 Add division id to HL7 message
S DIV1=$$GET1^DIQ(44,CLINID_",",3.5,"I") S:$G(DIV1)>0 DIV2=$P(^DG(40.8,$G(DIV1),0),"^",7) S:$G(DIV2)>0 DIV3=$$GET1^DIQ(4,DIV2_",",99,"E")
D SET^HLOAPI(.SEG,"LOC",0) ; Set the segment type
D SET^HLOAPI(.SEG,CLINID,1) ; IEN from the Hospital Location file
D SET^HLOAPI(.SEG,CLINNM,2) ; .01 from the Hospital Location file for the clinic
D SET^HLOAPI(.SEG,"C",3) ; location type, this will always be C for clinic
S INSTNUM=$$KSP^XUPARAM("INST"),INSTNUM=$P(^DIC(4,INSTNUM,99),"^")
S VISN=$$VISN(INSTNUM) S:$G(VISN)'>0 VISN=0 ; Makes the assumption that a medical center only has one Parent Facility in the Institution file
; Need to change how LOC is used to set the data on the LOC segment. this is causing problems
S LOC=$G(CLINNM)_"^"_INSTNUM_"^^^"_$G(VISN)_"^"_$G(STATNUM)
D SET^HLOAPI(.SEG,$G(CLINNM),4,1) ; Clinic name
D SET^HLOAPI(.SEG,$G(INSTNUM),4,2) ; institution number
D SET^HLOAPI(.SEG,$G(VISN),4,5) ; visn
D SET^HLOAPI(.SEG,$G(DIV3),4,3) ; station number Patch 714 PB 11/07/19 division id as station number
Q
NTE(CLINID,SEQ,SEG) ;
;only one NTE per message. has the clinic start time and number of overbooks per day
N CLINSTRT,OVERBK
S CLINSTRT=CLIN(44,CLINID_",",1914,"E"),OVERBK=CLIN(44,CLINID_",",1918,"E")
D SET^HLOAPI(.SEG,"NTE",0)
D SET^HLOAPI(.SEG,1,1)
D SET^HLOAPI(.SEG,$G(CLINSTRT),2)
D SET^HLOAPI(.SEG,$G(OVERBK),3)
Q
LDP(CLINID,SEQ,SEG) ;
N LS,TSPEC,PSTOP,SSTOP,PSNM,CSNM,ACT
D ACT
S LS=CLIN(44,CLINID_",",9,"E")
S TSPEC=CLIN(44,CLINID_",",9.5,"E")
S PSTOP=CLIN(44,CLINID_",",8,"I"),SSTOP=CLIN(44,CLINID_",",2503,"I"),PSNM=CLIN(44,CLINID_",",8,"E"),CSNM=CLIN(44,CLINID_",",2503,"E")
S:$G(PSTOP)>0 PSTOP=$$GET1^DIQ(40.7,PSTOP_",",1,"I")
S:$G(SSTOP)>0 SSTOP=$$GET1^DIQ(40.7,SSTOP_",",1,"I")
D SET^HLOAPI(.SEG,"LDP",0)
D SET^HLOAPI(.SEG,CLINID,1)
;NEED TO CHANGE THE SEGMENT FIELD SET BELOW TO SET INTO THE SUB FIELDS CORRECTLY
D SET^HLOAPI(.SEG,LOC,2)
D SET^HLOAPI(.SEG,$G(LS),3)
D SET^HLOAPI(.SEG,$G(TSPEC),4)
D SET^HLOAPI(.SEG,$G(ACT),6)
D SET^HLOAPI(.SEG,$G(ACTDT),7) ; reactivation date
D SET^HLOAPI(.SEG,$G(INACTDT),8) ; inactivation date
D SET^HLOAPI(.SEG,"UNK",9)
; change the line below to use HLO to set up the field and sub fields don't do manually
D SET^HLOAPI(.SEG,$G(PSTOP)_"^"_$G(PSNM)_"^CLINIC STOP^"_$G(SSTOP)_"^"_$G(CSNM),12) ;STOP CODES
Q
ZPU(CLINID,SEQ,SEG) ;
N XX,SEQA
; Need code to loop thru the privileged users and add a segment for each privileged user
S XX=0,SEQA=1 F S XX=$O(^SC(CLINID,"SDPRIV",XX)) Q:XX'>0 D
.N CIEN S CIEN=+$P(^SC(CLINID,"SDPRIV",XX,0),"^")
.Q:$G(CIEN)'>0
.N CLERKNM,CLERKEMAIL,CVPID
.S CLERKNM=$$GET1^DIQ(200,CIEN_",",.01,"E"),CLERKEMAIL=$$GET1^DIQ(200,CIEN_",",.151,"E"),CVPID=$$GET1^DIQ(200,CIEN_",",9000,"I")
.I $G(CLERKNM)'="",$G(CLERKEMAIL)="" S CLERKEMAIL="UNK"
.S:$G(CVPID)="" CVPID="0"
.D SET^HLOAPI(.SEG,"ZPU",0)
.D SET^HLOAPI(.SEG,SEQA,1)
.D SET^HLOAPI(.SEG,CLERKNM,2)
.D SET^HLOAPI(.SEG,CLERKEMAIL,3)
.D SET^HLOAPI(.SEG,CVPID,4)
.S SEQA=$G(SEQA)+1
.I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q
Q
ZDP(CLINID,SEQ,SEG) ; has the default provider duz, default provider name and default provider email
;default provider duz comes from the Clinic in file 44. provider name and email from file 2
K PROVDUZ,PROVNM,PROVEMAIL,VPID
;S PROVNM="BURKHALTER,PHIL",PROVEMAIL="phil.burkhalter@anymail.com",VPID="123245V123"
S PROVDUZ=CLIN(44,CLINID_",",16,"I"),PROVNM=CLIN(44,CLINID_",",16,"E")
S PROVEMAIL="",VPID=""
I $G(PROVDUZ)>0 S PROVEMAIL=$$GET1^DIQ(200,PROVDUZ_",",.151,"E","SDTMPERR"),VPID=$$GET1^DIQ(200,PROVDUZ_",",9000,"I","SDTMPERR")
S:$G(PROVEMAIL)="" PROVEMAIL="UNK"
S:$G(VPID)="" VPID="0"
D SET^HLOAPI(.SEG,"ZDP",0)
D SET^HLOAPI(.SEG,SEQ,1)
D SET^HLOAPI(.SEG,$G(PROVNM),2)
D SET^HLOAPI(.SEG,$G(PROVEMAIL),3)
D SET^HLOAPI(.SEG,$G(VPID),4)
K PROVNM,PROVEMAIL,VPID
Q
CLINDATA(CLINID) ; get the clinic data, add code to pull the data from file 44 and 200
N FLDS
Q:$G(CLINID)'>0
S IEN=CLINID_",",FLDS=".01;3;8;9;9.5;16;1914;1918;2503;2505;2506"
D GETS^DIQ(44,IEN,FLDS,"IE","CLIN","TMPERR")
Q
VISN(INSTNUM) ;
N IEN,VISNPTR
S VISN=0
S IEN=$$IEN^XUAF4(INSTNUM)
S:$G(IEN)>0 VISNPTR=$P(^DIC(4,IEN,7,1,0),"^",2)
I $G(VISNPTR)>0 D
.S VISN=$P($G(^DIC(4,VISNPTR,0)),"^",1)
.S VISN=$P(VISN," ",2)
Q VISN
;
ACT ;888 Correct logic bug
N INACTDT,ACTDT
S INACTDT=CLIN(44,CLINID_",",2505,"I"),ACTDT=CLIN(44,CLINID_",",2506,"I")
S ACT="I"
I INACTDT="",ACTDT="" S ACT="A" Q
I INACTDT="" S ACT="A" Q
I ((INACTDT'="")&(INACTDT>DT))!((ACTDT'="")&(ACTDT'>DT)) S ACT="A"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDTMPHLB 8250 printed Dec 13, 2024@03:01:34 Page 2
SDTMPHLB ;MS/PB - TMP HL7 Routine;MAY 29, 2018
+1 ;;5.3;Scheduling;**704,733,714,773,888**;AUG 13, 1993;Build 8
+2 QUIT
EN(CLINID) ; Entry to the routine to build an HL7 message
+1 ;notification to TMP about a new appointment in a TeleHealth Clinic
+2 ;put in check for this to be a telehealth clinic. if not a telehealth clinic quit
+3 ;Call API to create MSH segment
+4 ;
+5 ;need to parse data from the file based on clinic, need to get VISN, overbooks and clinic status and privileged users
+6 ;default provider and default provider email.
+7 NEW STOP,SSTOP,PSTOP,MSG,RTN,UPDTTM
+8 SET PSTOP=$PIECE(^SC(CLINID,0),"^",7)
SET SSTOP=$PIECE(^SC(CLINID,0),"^",18)
+9 ;if both PSTOP and SSTOP are null, the clinic is not a tele health clinic so quit
IF ($GET(PSTOP)=""&($GET(SSTOP)=""))
QUIT 0
+10 ;if STOP=0, primary stop code is not a tele health stop code so check secondary stop code to see if it is a tele health clinic
if $GET(PSTOP)'=""
SET STOP=$$CHKCLIN^SDTMPHLA($GET(PSTOP))
+11 ;I $G(STOP)=0,($$CHKCLIN^SDTMPHLA($G(SSTOP))'="") Q ;if primary stop code is not tele health check secondary stop code if secondary not tele health stop
+12 ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop
IF $GET(STOP)=0
if $GET(SSTOP)'>0
QUIT
SET STOP=$$CHKCLIN^SDTMPHLA(SSTOP)
+13 ; Double check for either primary or secondary stop code to be a tele health clinic
if $GET(STOP)=0
QUIT
+14 NEW PARMS,SEG,WHOTO,ERROR,SEQ
+15 SET PARMS("MESSAGE TYPE")="MFN"
SET PARMS("EVENT")="M05"
+16 IF '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
WRITE !,"ERR= "_$GET(ERROR)
QUIT 0
+17 SET SEQ=1
+18 NEW %
DO NOW^%DTC
SET UPDTTM=$$TMCONV^SDTMPHLA(%,$$INST^SDTMPHLA(CLINID))
+19 KILL CLIN,IEN
SET IEN=CLINID_","
DO CLINDATA(IEN)
+20 DO MFI(CLINID,SEQ,.SEG)
+21 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
WRITE !,"NOT ADDED "_$GET(ERROR)_" "
QUIT 0
+22 DO MFE(CLINID,SEQ,.SEG)
+23 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+24 DO LOC(CLINID,SEQ,.SEG)
+25 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+26 DO NTE(CLINID,SEQ,.SEG)
+27 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+28 DO LDP(CLINID,SEQ,.SEG)
+29 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+30 DO ZDP(CLINID,SEQ,.SEG)
+31 IF $DATA(SEG)
IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+32 DO ZPU(CLINID,SEQ,.SEG)
+33 SET PARMS("SENDING APPLICATION")="TMP_OUT"
+34 SET WHOTO("RECEIVING APPLICATION")="TMP VIMT"
+35 SET WHOTO("FACILITY LINK NAME")="TMP_SEND"
+36 SET WHOTO("FACILITY LINK IEN")=$ORDER(^HLCS(870,"B","TMP_SEND",0))
+37 SET RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
+38 KILL CLINID,LOC
+39 QUIT RTN
MFI(CLINID,SEQ,SEG) ;
+1 NEW APPID
+2 ; Set the segment type
DO SET^HLOAPI(.SEG,"MFI",0)
+3 ;D SET^HLOAPI(.SEG,"MFI",0) ; Set segment type to MFI
+4 ; Set CLINIC ID
DO SET^HLOAPI(.SEG,CLINID,1)
+5 SET APPID="44^HOSPITAL LOCATION"
+6 ; File to be updated
DO SET^HLOAPI(.SEG,APPID,2)
+7 ; Hard set as an UPD to the file -- Need code to determine if new or update
DO SET^HLOAPI(.SEG,"UPD",3)
+8 ; date/time the update occurred
DO SET^HLOAPI(.SEG,UPDTTM,4)
+9 ; effective date/time
DO SET^HLOAPI(.SEG,UPDTTM,5)
+10 ; response level code, this is set to AL for ALWAYS
DO SET^HLOAPI(.SEG,"AL",6)
+11 QUIT
MFE(CLINID,SEQ,SEG) ;
+1 NEW TYPE
+2 ; Set the segment type
DO SET^HLOAPI(.SEG,"MFE",0)
+3 ; this will be MAD for adding a new clinic, MUP for an update, MDS do deactivate and MAC for reactivate
SET TYPE="MUP"
+4 ; type of action
DO SET^HLOAPI(.SEG,TYPE,1)
+5 ; Clinic IEN from the Hospital Location file
DO SET^HLOAPI(.SEG,CLINID,2)
+6 DO SET^HLOAPI(.SEG,UPDTTM,3)
+7 DO SET^HLOAPI(.SEG,CLINID,4)
+8 ; Primary key value type, this will always be CE
DO SET^HLOAPI(.SEG,"CE",5)
+9 QUIT
LOC(CLINID,SEQ,SEG) ;
+1 NEW INSTNUM,VISN,STATNUM,CLINNM,DIV,DIV1,DIV2,DIV3
+2 KILL LOC
+3 SET CLINNM=CLIN(44,CLINID_",",.01,"E")
SET STATNUM=$GET(CLIN(44,CLINID_",",3,"I"))
+4 ;Patch 714 PB - 11/07/19 Add division id to HL7 message
+5 SET DIV1=$$GET1^DIQ(44,CLINID_",",3.5,"I")
if $GET(DIV1)>0
SET DIV2=$PIECE(^DG(40.8,$GET(DIV1),0),"^",7)
if $GET(DIV2)>0
SET DIV3=$$GET1^DIQ(4,DIV2_",",99,"E")
+6 ; Set the segment type
DO SET^HLOAPI(.SEG,"LOC",0)
+7 ; IEN from the Hospital Location file
DO SET^HLOAPI(.SEG,CLINID,1)
+8 ; .01 from the Hospital Location file for the clinic
DO SET^HLOAPI(.SEG,CLINNM,2)
+9 ; location type, this will always be C for clinic
DO SET^HLOAPI(.SEG,"C",3)
+10 SET INSTNUM=$$KSP^XUPARAM("INST")
SET INSTNUM=$PIECE(^DIC(4,INSTNUM,99),"^")
+11 ; Makes the assumption that a medical center only has one Parent Facility in the Institution file
SET VISN=$$VISN(INSTNUM)
if $GET(VISN)'>0
SET VISN=0
+12 ; Need to change how LOC is used to set the data on the LOC segment. this is causing problems
+13 SET LOC=$GET(CLINNM)_"^"_INSTNUM_"^^^"_$GET(VISN)_"^"_$GET(STATNUM)
+14 ; Clinic name
DO SET^HLOAPI(.SEG,$GET(CLINNM),4,1)
+15 ; institution number
DO SET^HLOAPI(.SEG,$GET(INSTNUM),4,2)
+16 ; visn
DO SET^HLOAPI(.SEG,$GET(VISN),4,5)
+17 ; station number Patch 714 PB 11/07/19 division id as station number
DO SET^HLOAPI(.SEG,$GET(DIV3),4,3)
+18 QUIT
NTE(CLINID,SEQ,SEG) ;
+1 ;only one NTE per message. has the clinic start time and number of overbooks per day
+2 NEW CLINSTRT,OVERBK
+3 SET CLINSTRT=CLIN(44,CLINID_",",1914,"E")
SET OVERBK=CLIN(44,CLINID_",",1918,"E")
+4 DO SET^HLOAPI(.SEG,"NTE",0)
+5 DO SET^HLOAPI(.SEG,1,1)
+6 DO SET^HLOAPI(.SEG,$GET(CLINSTRT),2)
+7 DO SET^HLOAPI(.SEG,$GET(OVERBK),3)
+8 QUIT
LDP(CLINID,SEQ,SEG) ;
+1 NEW LS,TSPEC,PSTOP,SSTOP,PSNM,CSNM,ACT
+2 DO ACT
+3 SET LS=CLIN(44,CLINID_",",9,"E")
+4 SET TSPEC=CLIN(44,CLINID_",",9.5,"E")
+5 SET PSTOP=CLIN(44,CLINID_",",8,"I")
SET SSTOP=CLIN(44,CLINID_",",2503,"I")
SET PSNM=CLIN(44,CLINID_",",8,"E")
SET CSNM=CLIN(44,CLINID_",",2503,"E")
+6 if $GET(PSTOP)>0
SET PSTOP=$$GET1^DIQ(40.7,PSTOP_",",1,"I")
+7 if $GET(SSTOP)>0
SET SSTOP=$$GET1^DIQ(40.7,SSTOP_",",1,"I")
+8 DO SET^HLOAPI(.SEG,"LDP",0)
+9 DO SET^HLOAPI(.SEG,CLINID,1)
+10 ;NEED TO CHANGE THE SEGMENT FIELD SET BELOW TO SET INTO THE SUB FIELDS CORRECTLY
+11 DO SET^HLOAPI(.SEG,LOC,2)
+12 DO SET^HLOAPI(.SEG,$GET(LS),3)
+13 DO SET^HLOAPI(.SEG,$GET(TSPEC),4)
+14 DO SET^HLOAPI(.SEG,$GET(ACT),6)
+15 ; reactivation date
DO SET^HLOAPI(.SEG,$GET(ACTDT),7)
+16 ; inactivation date
DO SET^HLOAPI(.SEG,$GET(INACTDT),8)
+17 DO SET^HLOAPI(.SEG,"UNK",9)
+18 ; change the line below to use HLO to set up the field and sub fields don't do manually
+19 ;STOP CODES
DO SET^HLOAPI(.SEG,$GET(PSTOP)_"^"_$GET(PSNM)_"^CLINIC STOP^"_$GET(SSTOP)_"^"_$GET(CSNM),12)
+20 QUIT
ZPU(CLINID,SEQ,SEG) ;
+1 NEW XX,SEQA
+2 ; Need code to loop thru the privileged users and add a segment for each privileged user
+3 SET XX=0
SET SEQA=1
FOR
SET XX=$ORDER(^SC(CLINID,"SDPRIV",XX))
if XX'>0
QUIT
Begin DoDot:1
+4 NEW CIEN
SET CIEN=+$PIECE(^SC(CLINID,"SDPRIV",XX,0),"^")
+5 if $GET(CIEN)'>0
QUIT
+6 NEW CLERKNM,CLERKEMAIL,CVPID
+7 SET CLERKNM=$$GET1^DIQ(200,CIEN_",",.01,"E")
SET CLERKEMAIL=$$GET1^DIQ(200,CIEN_",",.151,"E")
SET CVPID=$$GET1^DIQ(200,CIEN_",",9000,"I")
+8 IF $GET(CLERKNM)'=""
IF $GET(CLERKEMAIL)=""
SET CLERKEMAIL="UNK"
+9 if $GET(CVPID)=""
SET CVPID="0"
+10 DO SET^HLOAPI(.SEG,"ZPU",0)
+11 DO SET^HLOAPI(.SEG,SEQA,1)
+12 DO SET^HLOAPI(.SEG,CLERKNM,2)
+13 DO SET^HLOAPI(.SEG,CLERKEMAIL,3)
+14 DO SET^HLOAPI(.SEG,CVPID,4)
+15 SET SEQA=$GET(SEQA)+1
+16 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT
End DoDot:1
+17 QUIT
ZDP(CLINID,SEQ,SEG) ; has the default provider duz, default provider name and default provider email
+1 ;default provider duz comes from the Clinic in file 44. provider name and email from file 2
+2 KILL PROVDUZ,PROVNM,PROVEMAIL,VPID
+3 ;S PROVNM="BURKHALTER,PHIL",PROVEMAIL="phil.burkhalter@anymail.com",VPID="123245V123"
+4 SET PROVDUZ=CLIN(44,CLINID_",",16,"I")
SET PROVNM=CLIN(44,CLINID_",",16,"E")
+5 SET PROVEMAIL=""
SET VPID=""
+6 IF $GET(PROVDUZ)>0
SET PROVEMAIL=$$GET1^DIQ(200,PROVDUZ_",",.151,"E","SDTMPERR")
SET VPID=$$GET1^DIQ(200,PROVDUZ_",",9000,"I","SDTMPERR")
+7 if $GET(PROVEMAIL)=""
SET PROVEMAIL="UNK"
+8 if $GET(VPID)=""
SET VPID="0"
+9 DO SET^HLOAPI(.SEG,"ZDP",0)
+10 DO SET^HLOAPI(.SEG,SEQ,1)
+11 DO SET^HLOAPI(.SEG,$GET(PROVNM),2)
+12 DO SET^HLOAPI(.SEG,$GET(PROVEMAIL),3)
+13 DO SET^HLOAPI(.SEG,$GET(VPID),4)
+14 KILL PROVNM,PROVEMAIL,VPID
+15 QUIT
CLINDATA(CLINID) ; get the clinic data, add code to pull the data from file 44 and 200
+1 NEW FLDS
+2 if $GET(CLINID)'>0
QUIT
+3 SET IEN=CLINID_","
SET FLDS=".01;3;8;9;9.5;16;1914;1918;2503;2505;2506"
+4 DO GETS^DIQ(44,IEN,FLDS,"IE","CLIN","TMPERR")
+5 QUIT
VISN(INSTNUM) ;
+1 NEW IEN,VISNPTR
+2 SET VISN=0
+3 SET IEN=$$IEN^XUAF4(INSTNUM)
+4 if $GET(IEN)>0
SET VISNPTR=$PIECE(^DIC(4,IEN,7,1,0),"^",2)
+5 IF $GET(VISNPTR)>0
Begin DoDot:1
+6 SET VISN=$PIECE($GET(^DIC(4,VISNPTR,0)),"^",1)
+7 SET VISN=$PIECE(VISN," ",2)
End DoDot:1
+8 QUIT VISN
+9 ;
ACT ;888 Correct logic bug
+1 NEW INACTDT,ACTDT
+2 SET INACTDT=CLIN(44,CLINID_",",2505,"I")
SET ACTDT=CLIN(44,CLINID_",",2506,"I")
+3 SET ACT="I"
+4 IF INACTDT=""
IF ACTDT=""
SET ACT="A"
QUIT
+5 IF INACTDT=""
SET ACT="A"
QUIT
+6 IF ((INACTDT'="")&(INACTDT>DT))!((ACTDT'="")&(ACTDT'>DT))
SET ACT="A"
+7 QUIT
