- 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 Feb 19, 2025@00:25:15 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