XUPSB01 ;ALB/CMC - B01/B02 BUILDER ;2 Sep 2010 5:25 PM
;;8.0;KERNEL;**551**;Jul 10, 1995;Build 2
;
BLD(CONTEXT,NPIEN,PIEN) ;BUILD AND SEND B01 OR B02 MSG
;CONTEXT - is ADD or UPDATE depending on the event
;NPIEN - is the internal entry number of the record in file 200
;PIEN - is the internal entry number of the record in file 450
;
TASK ;
I CONTEXT="UPDATE",$G(NPIEN)'="" D INIT^HLFNC2("XUPS B02 SERVER",.HL) S XUPS="XUPS B02 SERVER HLO MPI",XUPSIEN=NPIEN
I CONTEXT="ADD",$G(NPIEN)'="" D INIT^HLFNC2("XUPS B01 SERVER",.HL) S XUPS="XUPS B01 SERVER HLO MPI",XUPSIEN=NPIEN
I CONTEXT="ADD",$G(PIEN)'="" D INIT^HLFNC2("PRS B01 SERVER",.HL) S XUPS="PRS B01 SERVER HLO MPI",XUPSIEN=PIEN
I CONTEXT="UPDATE",$G(PIEN)'="" D INIT^HLFNC2("PRS B02 SERVER",.HL) S XUPS="PRS B02 SERVER HLO MPI",XUPSIEN=PIEN
I $O(HL(""))="" Q "-1^"_$P(HL,"^",2)
N HLECH,HLFS,COMP,REP,SUBCOMP,ERR,STF,XUORG,PRA,HLA,TIEN
S HLECH=HL("ECH"),HLFS=HL("FS"),COMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4)
S ERR=""
;
I $G(NPIEN)'="" D
.;BUILD FOR NEW PERSON
.S EVN="EVN"_HL("FS")_HL("FS")_$$HLDATE^HLFNC(DT)_HL("FS")_HL("FS")
.D EN^XUPSSTF(NPIEN,"2,3,4,5,6,10,11",.HL,.STF,.STFC) Q:+STF=-1
.D EN^XUPSORG(NPIEN,.HL,.XUORG) Q:+$G(XUORG)=-1
.S PRA=$$EN^XUPSPRA(NPIEN,"6",.HL) Q:+PRA=-1
.S HLA("HLS",1)=EVN
.S HLA("HLS",2)=STF
.I $D(STFC) D
..;STFC HAS THE REST OF THE STF SEGMENT
..S STFCNT=1,STFIEN=0
..F S STFIEN=$O(STFC(STFIEN)) Q:'STFIEN D
...S HLA("HLS",2,STFCNT)=STFC(STFIEN)
.S HLA("HLS",3)=PRA,CNT=4
.N TMP S TMP=0 F S TMP=$O(XUORG(TMP)) Q:TMP="" S HLA("HLS",CNT)=XUORG(TMP),CNT=CNT+1
;
I $G(PIEN)'="" D
.;BUILD FOR PAID EMPLOYEE
.S EVN="EVN"_HL("FS")_HL("FS")_$$HLDATE^HLFNC(DT)_HL("FS")_HL("FS")
.S STF=$$STF^PRSMPI(PIEN,.HL,"2,3,5,6,10,11") Q:+STF=-1
.S HLA("HLS",1)=EVN
.S HLA("HLS",2)=STF
;
I $D(HLA("HLS")) D
.;SEND VIA HLO
.;LINK IS HARD SET IN PROTOCOL AT THIS POINT
.S TIEN=XUPSIEN
.I $L(TIEN)<3 S TIEN=0_TIEN I $L(TIEN)<3 S TIEN=0_TIEN
.S HLP("SEQUENCE QUEUE")="XUPS B01 B02 "_$E(TIEN,$L(TIEN)-3,$L(TIEN))
.S HLP("QUEUE")="XUPS B01 B02 "_$E(TIEN,$L(TIEN)-3,$L(TIEN))
.I '$$PATCH^XPDUTL("HL*1.6*134") S HLRESLT=$$EN^HLOCNRT(XUPS,"LM",.HLP)
.I $$PATCH^XPDUTL("HL*1.6*134") S HLRESLT=$$EN^HLOCNRT(XUPS,"LM",.HLP,"",.MHLOMSG)
.D KILL^HLTRANS
Q
;
B01AP ;APP ACK PROCEES FOR B01 for NEW PERSON
;PARSE BACK TO ORIGINAL MESSAGE TO GET 'WHO' we are triggering B02 for
I '$$STARTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR) D Q ;COULDN'T GET MESSAGE, DO WHAT?
.;NOT SURE WHAT WE ARE DOING HERE
; can successfully get message
S HL("ETN")=HDR("EVENT"),HL("Q")="""""",HL("FS")=HDR("FIELD SEPARATOR")
S HL("SFN")=HDR("SENDING FACILITY",1)_HDR("COMPONENT SEPARATOR")_HDR("SENDING FACILITY",2)_HDR("COMPONENT SEPARATOR")_HDR("SENDING FACILITY",3)
S HL("ECH")=HDR("COMPONENT SEPARATOR")_HDR("REPETITION SEPARATOR")_HDR("ESCAPE CHARACTER")_HDR("SUBCOMPONENT SEPARATOR")
F Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG) D
.S SG=$E(SEG(1),1,3)
.I SG="MSA" S MSG=SEG(1) D MSA(.MSG,.ARRAY,.HL,.HDR)
;set the new enumeration competed date/time field
;
Q
MSA(MSG,ARRAY,HL,HDR) ;
N EXIT,ACKID,TMP,SEG,SG,HDR2,HLMST2,ERR,RSLT,ARRAY2,MSG2,ERROR,TMP,ARR,RES,FIND,WHO,TXT
S EXIT=0,ACKID=$G(HLMSGIEN) K HLMST2
S TMP=$$STARTMSG^HLOPRS(.HLMST2,HLMSTATE("ACK TO IEN"),.HDR2)
S HL("ETN")=HDR2("EVENT"),HL("Q")="""""",HL("FS")=HDR2("FIELD SEPARATOR")
S HL("SFN")=HDR2("RECEIVING FACILITY",1)_HDR2("COMPONENT SEPARATOR")_HDR2("RECEIVING FACILITY",2)_HDR2("COMPONENT SEPARATOR")_HDR2("RECEIVING FACILITY",3) ;WHO THE MESSAGE WENT TO ORIGINALLY
S HL("ECH")=HDR2("COMPONENT SEPARATOR")_HDR2("REPETITION SEPARATOR")_HDR2("ESCAPE CHARACTER")_HDR2("SUBCOMPONENT SEPARATOR")
N SEQ2,LASTID,IDCNT,IDS,CNT,ACNT,ID,NPIEN,PIEN
S NPIEN="",PIEN=""
I TMP D
.F Q:'$$HLNEXT^HLOMSG(.HLMST2,.SEG) D
..S SG=$E(SEG(1),1,3)
..I SG="STF" D
...;NEED SEQ 2 fields
...S SEQ2=$P(SG,HDR("FIELD SEPARATOR"),3)
...S IDCNT=1,IDS="" F S IDS=$P(SEQ2,HDR("REPETITION SEPARATOR"),IDCNT) Q:IDS="" D
....S IEN=$P(IDS,HDR("COMPONENT SEPARATOR"),1)
....S AA=$P($P(IDS,HDR("COMPONENT SEPARATOR"),4),HDR("SUBCOMPONENT SEPARATOR"),1)
....S TYPE=$P(IDS,HDR("COMPONENT SEPARATOR"),5)
....S FAC=$P($P(IDS,HDR("COMPONENT SEPARATOR"),6),HDR("SUBCOMPONENT SEPARATOR"),2)
....I AA="USVHA",TYPE="PN" S NPIEN=IEN
....I AA="USVHA",TYPE="EI" S PIEN=IEN
....S IDCNT=IDCNT+1
.;
.I $P(MSG,HDR("FIELD SEPARATOR"),2)'="AA" D
..;NOT A SUCCESSFULLY PROCESSED MSG -- NOT AA -- LOG EXCEPTION?
.I $P(MSG,HDR("FIELD SEPARATOR"),2)="AA" D
..;SET enumeration complete date/time field
..;which file? 200 or 450
..I $G(NPIEN)'="",HDR("SENDING APPLICATION")["XUPS" D
...;FILE 200
...D NOW^%DTC
...S FDA(200,NPIEN_",",901)=%
...D FILE^DIE("E","FDA","PRSERR")
..I $G(PIEN)'="",HDR("SENDING APPLICATION")["PRS" D
...;FILE 450
...D NOW^%DTC
...S FDA(450,PIEN_",",901)=%
...D FILE^DIE("E","FDA","PRSERR")
..;trigger PMU-B02 update message (task)
..S ZTSAVE("CONTEXT")="UPDATE"
..I HDR("SENDING APPLICATION")["XUPS" S ZTSAVE("NPIEN")=NPIEN
..I HDR("SENDING APPLICATION")["PRSMPI" S ZTSAVE("PIEN")=PIEN
..S ZTRTN="TASK^XUPSB01",ZTDESC="B02 HLO to MPI for NPIEN= "_$G(ZTSAVE("NPIEN"))_" PIEN= "_$G(ZTSAVE("PIEN"))
..S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
..D ^%ZTLOAD
..K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
;
Q
;
B02AP ;APP ACK PROCESS FOR B02 for NEW PERSON
;nothing needed at this point
Q
;
STF(SG,HDR) ;STF TESTER
;NEED SEQ 2 fields
S SEQ2=$P(SG,HDR("FIELD SEPARATOR"),3)
S IDCNT=1,IDS="" F S IDS=$P(SEQ2,HDR("REPETITION SEPARATOR"),IDCNT) Q:IDS="" D
.S IEN=$P(IDS,HDR("COMPONENT SEPARATOR"),1)
.S AA=$P($P(IDS,HDR("COMPONENT SEPARATOR"),4),HDR("SUBCOMPONENT SEPARATOR"),1)
.S TYPE=$P(IDS,HDR("COMPONENT SEPARATOR"),5)
.S FAC=$P($P(IDS,HDR("COMPONENT SEPARATOR"),6),HDR("SUBCOMPONENT SEPARATOR"),2)
.I AA="USVHA",TYPE="PN" S NPIEN=IEN
.I AA="USVHA",TYPE="EI" S PIEN=IEN
.S IDCNT=IDCNT+1
;
;SET enumeration complete date/time field
;which file? 200 or 450
UP I $G(NPIEN)'="",HDR("SENDING APPLICATION")="XUPS APP" D
.;FILE 200
.D NOW^%DTC
.S FDA(200,NPIEN_",",901)=%
.D FILE^DIE("E","FDA","PRSERR")
I $G(PIEN)'="",HDR("SENDING APPLICATION")="PRSMPI APP" D
.;FILE 450
.D NOW^%DTC
.S FDA(450,PIEN_",",901)=%
.D FILE^DIE("E","FDA","PRSERR")
;trigger PMU-B02 update message (task)
S ZTSAVE("CONTEXT")="UPDATE"
I HDR("SENDING APPLICATION")="XUPS APP" S ZTSAVE("NPIEN")=NPIEN
I HDR("SENDING APPLICATION")="PRSMPI APP" S ZTSAVE("PIEN")=PIEN
S ZTRTN="TASK^XUPSB01",ZTDESC="B02 HLO to MPI for NPIEN= "_$G(ZTSAVE("NPIEN"))_" PIEN= "_$G(ZTSAVE("PIEN"))
S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
D ^%ZTLOAD
;K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPSB01 6839 printed Nov 22, 2024@17:21:47 Page 2
XUPSB01 ;ALB/CMC - B01/B02 BUILDER ;2 Sep 2010 5:25 PM
+1 ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 2
+2 ;
BLD(CONTEXT,NPIEN,PIEN) ;BUILD AND SEND B01 OR B02 MSG
+1 ;CONTEXT - is ADD or UPDATE depending on the event
+2 ;NPIEN - is the internal entry number of the record in file 200
+3 ;PIEN - is the internal entry number of the record in file 450
+4 ;
TASK ;
+1 IF CONTEXT="UPDATE"
IF $GET(NPIEN)'=""
DO INIT^HLFNC2("XUPS B02 SERVER",.HL)
SET XUPS="XUPS B02 SERVER HLO MPI"
SET XUPSIEN=NPIEN
+2 IF CONTEXT="ADD"
IF $GET(NPIEN)'=""
DO INIT^HLFNC2("XUPS B01 SERVER",.HL)
SET XUPS="XUPS B01 SERVER HLO MPI"
SET XUPSIEN=NPIEN
+3 IF CONTEXT="ADD"
IF $GET(PIEN)'=""
DO INIT^HLFNC2("PRS B01 SERVER",.HL)
SET XUPS="PRS B01 SERVER HLO MPI"
SET XUPSIEN=PIEN
+4 IF CONTEXT="UPDATE"
IF $GET(PIEN)'=""
DO INIT^HLFNC2("PRS B02 SERVER",.HL)
SET XUPS="PRS B02 SERVER HLO MPI"
SET XUPSIEN=PIEN
+5 IF $ORDER(HL(""))=""
QUIT "-1^"_$PIECE(HL,"^",2)
+6 NEW HLECH,HLFS,COMP,REP,SUBCOMP,ERR,STF,XUORG,PRA,HLA,TIEN
+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 SET ERR=""
+9 ;
+10 IF $GET(NPIEN)'=""
Begin DoDot:1
+11 ;BUILD FOR NEW PERSON
+12 SET EVN="EVN"_HL("FS")_HL("FS")_$$HLDATE^HLFNC(DT)_HL("FS")_HL("FS")
+13 DO EN^XUPSSTF(NPIEN,"2,3,4,5,6,10,11",.HL,.STF,.STFC)
if +STF=-1
QUIT
+14 DO EN^XUPSORG(NPIEN,.HL,.XUORG)
if +$GET(XUORG)=-1
QUIT
+15 SET PRA=$$EN^XUPSPRA(NPIEN,"6",.HL)
if +PRA=-1
QUIT
+16 SET HLA("HLS",1)=EVN
+17 SET HLA("HLS",2)=STF
+18 IF $DATA(STFC)
Begin DoDot:2
+19 ;STFC HAS THE REST OF THE STF SEGMENT
+20 SET STFCNT=1
SET STFIEN=0
+21 FOR
SET STFIEN=$ORDER(STFC(STFIEN))
if 'STFIEN
QUIT
Begin DoDot:3
+22 SET HLA("HLS",2,STFCNT)=STFC(STFIEN)
End DoDot:3
End DoDot:2
+23 SET HLA("HLS",3)=PRA
SET CNT=4
+24 NEW TMP
SET TMP=0
FOR
SET TMP=$ORDER(XUORG(TMP))
if TMP=""
QUIT
SET HLA("HLS",CNT)=XUORG(TMP)
SET CNT=CNT+1
End DoDot:1
+25 ;
+26 IF $GET(PIEN)'=""
Begin DoDot:1
+27 ;BUILD FOR PAID EMPLOYEE
+28 SET EVN="EVN"_HL("FS")_HL("FS")_$$HLDATE^HLFNC(DT)_HL("FS")_HL("FS")
+29 SET STF=$$STF^PRSMPI(PIEN,.HL,"2,3,5,6,10,11")
if +STF=-1
QUIT
+30 SET HLA("HLS",1)=EVN
+31 SET HLA("HLS",2)=STF
End DoDot:1
+32 ;
+33 IF $DATA(HLA("HLS"))
Begin DoDot:1
+34 ;SEND VIA HLO
+35 ;LINK IS HARD SET IN PROTOCOL AT THIS POINT
+36 SET TIEN=XUPSIEN
+37 IF $LENGTH(TIEN)<3
SET TIEN=0_TIEN
IF $LENGTH(TIEN)<3
SET TIEN=0_TIEN
+38 SET HLP("SEQUENCE QUEUE")="XUPS B01 B02 "_$EXTRACT(TIEN,$LENGTH(TIEN)-3,$LENGTH(TIEN))
+39 SET HLP("QUEUE")="XUPS B01 B02 "_$EXTRACT(TIEN,$LENGTH(TIEN)-3,$LENGTH(TIEN))
+40 IF '$$PATCH^XPDUTL("HL*1.6*134")
SET HLRESLT=$$EN^HLOCNRT(XUPS,"LM",.HLP)
+41 IF $$PATCH^XPDUTL("HL*1.6*134")
SET HLRESLT=$$EN^HLOCNRT(XUPS,"LM",.HLP,"",.MHLOMSG)
+42 DO KILL^HLTRANS
End DoDot:1
+43 QUIT
+44 ;
B01AP ;APP ACK PROCEES FOR B01 for NEW PERSON
+1 ;PARSE BACK TO ORIGINAL MESSAGE TO GET 'WHO' we are triggering B02 for
+2 ;COULDN'T GET MESSAGE, DO WHAT?
IF '$$STARTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR)
Begin DoDot:1
+3 ;NOT SURE WHAT WE ARE DOING HERE
End DoDot:1
QUIT
+4 ; can successfully get message
+5 SET HL("ETN")=HDR("EVENT")
SET HL("Q")=""""""
SET HL("FS")=HDR("FIELD SEPARATOR")
+6 SET HL("SFN")=HDR("SENDING FACILITY",1)_HDR("COMPONENT SEPARATOR")_HDR("SENDING FACILITY",2)_HDR("COMPONENT SEPARATOR")_HDR("SENDING FACILITY",3)
+7 SET HL("ECH")=HDR("COMPONENT SEPARATOR")_HDR("REPETITION SEPARATOR")_HDR("ESCAPE CHARACTER")_HDR("SUBCOMPONENT SEPARATOR")
+8 FOR
if '$$HLNEXT^HLOMSG(.HLMSTATE,.SEG)
QUIT
Begin DoDot:1
+9 SET SG=$EXTRACT(SEG(1),1,3)
+10 IF SG="MSA"
SET MSG=SEG(1)
DO MSA(.MSG,.ARRAY,.HL,.HDR)
End DoDot:1
+11 ;set the new enumeration competed date/time field
+12 ;
+13 QUIT
MSA(MSG,ARRAY,HL,HDR) ;
+1 NEW EXIT,ACKID,TMP,SEG,SG,HDR2,HLMST2,ERR,RSLT,ARRAY2,MSG2,ERROR,TMP,ARR,RES,FIND,WHO,TXT
+2 SET EXIT=0
SET ACKID=$GET(HLMSGIEN)
KILL HLMST2
+3 SET TMP=$$STARTMSG^HLOPRS(.HLMST2,HLMSTATE("ACK TO IEN"),.HDR2)
+4 SET HL("ETN")=HDR2("EVENT")
SET HL("Q")=""""""
SET HL("FS")=HDR2("FIELD SEPARATOR")
+5 ;WHO THE MESSAGE WENT TO ORIGINALLY
SET HL("SFN")=HDR2("RECEIVING FACILITY",1)_HDR2("COMPONENT SEPARATOR")_HDR2("RECEIVING FACILITY",2)_HDR2("COMPONENT SEPARATOR")_HDR2("RECEIVING FACILITY",3)
+6 SET HL("ECH")=HDR2("COMPONENT SEPARATOR")_HDR2("REPETITION SEPARATOR")_HDR2("ESCAPE CHARACTER")_HDR2("SUBCOMPONENT SEPARATOR")
+7 NEW SEQ2,LASTID,IDCNT,IDS,CNT,ACNT,ID,NPIEN,PIEN
+8 SET NPIEN=""
SET PIEN=""
+9 IF TMP
Begin DoDot:1
+10 FOR
if '$$HLNEXT^HLOMSG(.HLMST2,.SEG)
QUIT
Begin DoDot:2
+11 SET SG=$EXTRACT(SEG(1),1,3)
+12 IF SG="STF"
Begin DoDot:3
+13 ;NEED SEQ 2 fields
+14 SET SEQ2=$PIECE(SG,HDR("FIELD SEPARATOR"),3)
+15 SET IDCNT=1
SET IDS=""
FOR
SET IDS=$PIECE(SEQ2,HDR("REPETITION SEPARATOR"),IDCNT)
if IDS=""
QUIT
Begin DoDot:4
+16 SET IEN=$PIECE(IDS,HDR("COMPONENT SEPARATOR"),1)
+17 SET AA=$PIECE($PIECE(IDS,HDR("COMPONENT SEPARATOR"),4),HDR("SUBCOMPONENT SEPARATOR"),1)
+18 SET TYPE=$PIECE(IDS,HDR("COMPONENT SEPARATOR"),5)
+19 SET FAC=$PIECE($PIECE(IDS,HDR("COMPONENT SEPARATOR"),6),HDR("SUBCOMPONENT SEPARATOR"),2)
+20 IF AA="USVHA"
IF TYPE="PN"
SET NPIEN=IEN
+21 IF AA="USVHA"
IF TYPE="EI"
SET PIEN=IEN
+22 SET IDCNT=IDCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
+23 ;
+24 IF $PIECE(MSG,HDR("FIELD SEPARATOR"),2)'="AA"
Begin DoDot:2
+25 ;NOT A SUCCESSFULLY PROCESSED MSG -- NOT AA -- LOG EXCEPTION?
End DoDot:2
+26 IF $PIECE(MSG,HDR("FIELD SEPARATOR"),2)="AA"
Begin DoDot:2
+27 ;SET enumeration complete date/time field
+28 ;which file? 200 or 450
+29 IF $GET(NPIEN)'=""
IF HDR("SENDING APPLICATION")["XUPS"
Begin DoDot:3
+30 ;FILE 200
+31 DO NOW^%DTC
+32 SET FDA(200,NPIEN_",",901)=%
+33 DO FILE^DIE("E","FDA","PRSERR")
End DoDot:3
+34 IF $GET(PIEN)'=""
IF HDR("SENDING APPLICATION")["PRS"
Begin DoDot:3
+35 ;FILE 450
+36 DO NOW^%DTC
+37 SET FDA(450,PIEN_",",901)=%
+38 DO FILE^DIE("E","FDA","PRSERR")
End DoDot:3
+39 ;trigger PMU-B02 update message (task)
+40 SET ZTSAVE("CONTEXT")="UPDATE"
+41 IF HDR("SENDING APPLICATION")["XUPS"
SET ZTSAVE("NPIEN")=NPIEN
+42 IF HDR("SENDING APPLICATION")["PRSMPI"
SET ZTSAVE("PIEN")=PIEN
+43 SET ZTRTN="TASK^XUPSB01"
SET ZTDESC="B02 HLO to MPI for NPIEN= "_$GET(ZTSAVE("NPIEN"))_" PIEN= "_$GET(ZTSAVE("PIEN"))
+44 SET ZTIO=""
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
+45 DO ^%ZTLOAD
+46 KILL ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
End DoDot:2
End DoDot:1
+47 ;
+48 QUIT
+49 ;
B02AP ;APP ACK PROCESS FOR B02 for NEW PERSON
+1 ;nothing needed at this point
+2 QUIT
+3 ;
STF(SG,HDR) ;STF TESTER
+1 ;NEED SEQ 2 fields
+2 SET SEQ2=$PIECE(SG,HDR("FIELD SEPARATOR"),3)
+3 SET IDCNT=1
SET IDS=""
FOR
SET IDS=$PIECE(SEQ2,HDR("REPETITION SEPARATOR"),IDCNT)
if IDS=""
QUIT
Begin DoDot:1
+4 SET IEN=$PIECE(IDS,HDR("COMPONENT SEPARATOR"),1)
+5 SET AA=$PIECE($PIECE(IDS,HDR("COMPONENT SEPARATOR"),4),HDR("SUBCOMPONENT SEPARATOR"),1)
+6 SET TYPE=$PIECE(IDS,HDR("COMPONENT SEPARATOR"),5)
+7 SET FAC=$PIECE($PIECE(IDS,HDR("COMPONENT SEPARATOR"),6),HDR("SUBCOMPONENT SEPARATOR"),2)
+8 IF AA="USVHA"
IF TYPE="PN"
SET NPIEN=IEN
+9 IF AA="USVHA"
IF TYPE="EI"
SET PIEN=IEN
+10 SET IDCNT=IDCNT+1
End DoDot:1
+11 ;
+12 ;SET enumeration complete date/time field
+13 ;which file? 200 or 450
UP IF $GET(NPIEN)'=""
IF HDR("SENDING APPLICATION")="XUPS APP"
Begin DoDot:1
+1 ;FILE 200
+2 DO NOW^%DTC
+3 SET FDA(200,NPIEN_",",901)=%
+4 DO FILE^DIE("E","FDA","PRSERR")
End DoDot:1
+5 IF $GET(PIEN)'=""
IF HDR("SENDING APPLICATION")="PRSMPI APP"
Begin DoDot:1
+6 ;FILE 450
+7 DO NOW^%DTC
+8 SET FDA(450,PIEN_",",901)=%
+9 DO FILE^DIE("E","FDA","PRSERR")
End DoDot:1
+10 ;trigger PMU-B02 update message (task)
+11 SET ZTSAVE("CONTEXT")="UPDATE"
+12 IF HDR("SENDING APPLICATION")="XUPS APP"
SET ZTSAVE("NPIEN")=NPIEN
+13 IF HDR("SENDING APPLICATION")="PRSMPI APP"
SET ZTSAVE("PIEN")=PIEN
+14 SET ZTRTN="TASK^XUPSB01"
SET ZTDESC="B02 HLO to MPI for NPIEN= "_$GET(ZTSAVE("NPIEN"))_" PIEN= "_$GET(ZTSAVE("PIEN"))
+15 SET ZTIO=""
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
+16 DO ^%ZTLOAD
+17 ;K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
+18 QUIT
