DGVTSA28 ;7DELTA/KDC - VTS Stand alone Option routine ;07-MAR-2012
;;5.3;REGISTRATION;**853**;07-MAR-2012;Build 104
;
; Integration Agreements Utilized:
; START, EXC, STOP^RGHLLOG - #2796
; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
;
A28(DFN) ;BUILD AND SEND A28
N RESLT,CNT,MPI,EVN,TCNT,ERR,PD1,PID
N HL,MTIEN,HLDT,HLDT1,HLL,HLMID,HLNEXT
K HLA("HLA"),HLA("HLS")
S CNT=1
D INIT^HLFNC2("DG VTS ADT-A28 SERVER",.HL)
I $O(HL(""))="" Q "-1^"_$P(HL,"^",2)
S HLECH=HL("ECH"),HLFS=HL("FS"),COMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4)
D CREATE^HLTF(.HLMID,.MTIEN,.HLDT,.HLDT1)
S ERR="",TCNT=0
N NODE
S EVN(1)=$$EVN^VAFHLEVN("A28",4,)
Q:ERR'="" ERR
D BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR)
Q:ERR'="" ERR
S PD1(1)=$$EN^VAFHLPD1(DFN,",3,")
Q:ERR'="" ERR
S HLA("HLS",1)=EVN(1)
S HLA("HLS",3)=PD1(1)
S CNT=0 F S CNT=$O(PID(CNT)) Q:CNT="" D
.I CNT=1 S HLA("HLS",2)=PID(CNT)
.I CNT>1 S HLA("HLS",2,CNT-1)=PID(CNT)
S HLA("HLS",4)=$$EN1^VAFHLZPD(DFN,"1,17,21,34")
S HLL("LINKS",1)="DG VTS ADT-A28 CLIENT^AITC_VTS"
D GENERATE^HLMA("DG VTS ADT-A28 SERVER","LM",1,.RESLT,MTIEN)
K HLA,HLEID,HLL("LINKS"),COMP,REP,SUBCOMP,HLECH,HLFS,HLA("HLA"),HLA("HLS"),MPIFRSLT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGVTSA28 1235 printed Dec 13, 2024@02:59:13 Page 2
DGVTSA28 ;7DELTA/KDC - VTS Stand alone Option routine ;07-MAR-2012
+1 ;;5.3;REGISTRATION;**853**;07-MAR-2012;Build 104
+2 ;
+3 ; Integration Agreements Utilized:
+4 ; START, EXC, STOP^RGHLLOG - #2796
+5 ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
+6 ;
A28(DFN) ;BUILD AND SEND A28
+1 NEW RESLT,CNT,MPI,EVN,TCNT,ERR,PD1,PID
+2 NEW HL,MTIEN,HLDT,HLDT1,HLL,HLMID,HLNEXT
+3 KILL HLA("HLA"),HLA("HLS")
+4 SET CNT=1
+5 DO INIT^HLFNC2("DG VTS ADT-A28 SERVER",.HL)
+6 IF $ORDER(HL(""))=""
QUIT "-1^"_$PIECE(HL,"^",2)
+7 SET HLECH=HL("ECH")
SET HLFS=HL("FS")
SET COMP=$EXTRACT(HL("ECH"),1)
SET REP=$EXTRACT(HL("ECH"),2)
SET SUBCOMP=$EXTRACT(HL("ECH"),4)
+8 DO CREATE^HLTF(.HLMID,.MTIEN,.HLDT,.HLDT1)
+9 SET ERR=""
SET TCNT=0
+10 NEW NODE
+11 SET EVN(1)=$$EVN^VAFHLEVN("A28",4,)
+12 if ERR'=""
QUIT ERR
+13 DO BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR)
+14 if ERR'=""
QUIT ERR
+15 SET PD1(1)=$$EN^VAFHLPD1(DFN,",3,")
+16 if ERR'=""
QUIT ERR
+17 SET HLA("HLS",1)=EVN(1)
+18 SET HLA("HLS",3)=PD1(1)
+19 SET CNT=0
FOR
SET CNT=$ORDER(PID(CNT))
if CNT=""
QUIT
Begin DoDot:1
+20 IF CNT=1
SET HLA("HLS",2)=PID(CNT)
+21 IF CNT>1
SET HLA("HLS",2,CNT-1)=PID(CNT)
End DoDot:1
+22 SET HLA("HLS",4)=$$EN1^VAFHLZPD(DFN,"1,17,21,34")
+23 SET HLL("LINKS",1)="DG VTS ADT-A28 CLIENT^AITC_VTS"
+24 DO GENERATE^HLMA("DG VTS ADT-A28 SERVER","LM",1,.RESLT,MTIEN)
+25 KILL HLA,HLEID,HLL("LINKS"),COMP,REP,SUBCOMP,HLECH,HLFS,HLA("HLA"),HLA("HLS"),MPIFRSLT
+26 QUIT
