VAFHADT5 ;ALB/RJS - HL7 ADT BREAKOUT OF VAFHADT1 - APRIL 13,1995
;;5.3;Registration;**91**;Jun 06, 1996
;
;This routine was broken out of routine VAFHADT1 and
;contains numerous functions and procedures used by that routine
;
13(DFN) ;
N NHCUADMT,NHCUNODE,MEDADMT,MEDNODE,NHCUCHK,NHCUPIVT,MEDPIVT
N TRANSFER,TRNSNODE,PSUEDO,PSUNODE
S NHCUADMT=$O(VAFH(1,0))
S NHCUNODE=VAFH(1,NHCUADMT,"A")
S MEDADMT=$O(VAFH(1,NHCUADMT))
S MEDNODE=VAFH(1,MEDADMT,"A")
S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
I NHCUCHK'>0 D G MEDICAL
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+NHCUPIVT)
I NHCUCHK>0 D
. S TRANSFER=$O(VAFH(2,0))
. S TRNSNODE=VAFH(2,TRANSFER,"A")
. D BLDMSG^VAFHADT2(DFN,"A02",$P(TRNSNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
. S PSUEDO=$O(VAFH(3,0))
. S PSUNODE=VAFH(3,PSUEDO,"A")
. D BLDMSG^VAFHADT2(DFN,"A03",$P(PSUNODE,"^",1),"05",PSUEDO,+NHCUPIVT)
MEDICAL ;
D BLDMSG^VAFHADT2(DFN,"A01",$P(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
Q
;
14(DFN) ;
N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN,TRANNODE,NHCUDIS,DISNODE
S NHCUADMT=$O(VAFH(1,0))
S NHCUNODE=VAFH(1,NHCUADMT,"A")
S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
I +NHCUCHK'>0 D Q
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+NHCUPIVT)
S NHCUDIS=$O(VAFH(3,0))
S DISNODE=VAFH(3,NHCUDIS,"P")
D BLDMSG^VAFHADT2(DFN,"A13",$P(DISNODE,"^",1),"05",NHCUDIS,+NHCUPIVT)
S NHCUTRAN=$O(VAFH(2,0))
S TRANNODE=VAFH(2,NHCUTRAN,"A")
D BLDMSG^VAFHADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
Q
;
41(DFN) ;
N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,MEDADMT,MEDNODE,MEDPIVT,MEDCHK,NHCUPREV
S NHCUADMT=$O(VAFH(1,0))
S NHCUNODE=VAFH(1,NHCUADMT,"A")
S NHCUPREV=VAFH(1,NHCUADMT,"P")
S MEDADMT=$O(VAFH(1,NHCUADMT))
S MEDNODE=VAFH(1,MEDADMT,"A")
S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
S MEDCHK=$$PIVCHK^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
I +MEDCHK>0 D BLDMSG^VAFHADT2(DFN,"A03",$P(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
I +MEDCHK'>0 D
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,MEDADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+MEDPIVT)
I +NHCUCHK>0 D
. S NHCUDSDT=$P(VAFH(3,$P(NHCUPREV,"^",17),"P"),"^",1)
. D BLDMSG^VAFHADT2(DFN,"A13",NHCUDSDT,"05",NHCUADMT,+NHCUPIVT)
. D BLDMSG^VAFHADT2(DFN,"A02",$P(DGPMA,"^",1),"05",NHCUADMT,+NHCUPIVT)
I +NHCUCHK'>0 D
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+NHCUPIVT)
Q
43(DFN) ;
N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN,TRANNODE,NHCUDIS,DISNODE
S NHCUADMT=$O(VAFH(1,0))
S NHCUNODE=VAFH(1,NHCUADMT,"A")
S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
I +NHCUCHK'>0 D Q
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+NHCUPIVT)
S NHCUTRAN=$O(VAFH(2,0))
S TRANNODE=VAFH(2,NHCUTRAN,"A")
D BLDMSG^VAFHADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
S NHCUDIS=$O(VAFH(3,0))
S DISNODE=VAFH(3,NHCUDIS,"A")
D BLDMSG^VAFHADT2(DFN,"A03",$P(DISNODE,"^",1),"05",NHCUDIS,+NHCUPIVT)
Q
44(DFN) ;
N NHCUADMT,NHCUNODE,MEDADMT,MEDNODE,NHCUCHK,NHCUPIVT,MEDPIVT
N TRANSFER,TRANNODE
S MEDADMT=$O(VAFH(1,0))
S MEDNODE=VAFH(1,MEDADMT,"A")
S TRANSFER=$O(VAFH(2,0))
S TRANNODE=VAFH(2,TRANSFER,"A")
S NHCUADMT=$P(TRANNODE,"^",14)
S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
I +NHCUCHK'>0 D
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+NHCUPIVT)
I +NHCUCHK>0 D BLDMSG^VAFHADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
D BLDMSG^VAFHADT2(DFN,"A01",$P(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
Q
;
46(DFN) ;
N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN
N MEDADMT,MEDNODE,MEDDIS,MEDPIVT,DISNODE
S NHCUTRAN=$O(VAFH(2,0))
S NHCUNODE=VAFH(2,NHCUTRAN,"A")
S NHCUADMT=$P(VAFH(2,NHCUTRAN,"A"),"^",14)
S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
I +NHCUCHK'>0 D
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+NHCUPIVT)
I +NHCUCHK>0 D BLDMSG^VAFHADT2(DFN,"A02",$P(NHCUNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
S MEDADMT=$O(VAFH(1,0))
S MEDNODE=VAFH(1,MEDADMT,"A")
S MEDCHK=$$PIVCHK^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
S MEDDIS=$O(VAFH(3,0))
S DISNODE=VAFH(3,MEDDIS,"A")
S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
I +MEDCHK>0 D BLDMSG^VAFHADT2(DFN,"A03",$P(DISNODE,"^",1),"05",MEDDIS,+MEDPIVT)
I +MEDCHK'>0 D
. K HISTORY
. D BLDHIST^VAFHADT3(DFN,MEDADMT,"HISTORY")
. D:$D(VATRACE) HISTORY^VAFHADT4
. D ENTIRE^VAFHADT4(+MEDPIVT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHADT5 5687 printed Oct 16, 2024@19:03:15 Page 2
VAFHADT5 ;ALB/RJS - HL7 ADT BREAKOUT OF VAFHADT1 - APRIL 13,1995
+1 ;;5.3;Registration;**91**;Jun 06, 1996
+2 ;
+3 ;This routine was broken out of routine VAFHADT1 and
+4 ;contains numerous functions and procedures used by that routine
+5 ;
13(DFN) ;
+1 NEW NHCUADMT,NHCUNODE,MEDADMT,MEDNODE,NHCUCHK,NHCUPIVT,MEDPIVT
+2 NEW TRANSFER,TRNSNODE,PSUEDO,PSUNODE
+3 SET NHCUADMT=$ORDER(VAFH(1,0))
+4 SET NHCUNODE=VAFH(1,NHCUADMT,"A")
+5 SET MEDADMT=$ORDER(VAFH(1,NHCUADMT))
+6 SET MEDNODE=VAFH(1,MEDADMT,"A")
+7 SET NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+8 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+9 SET MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
+10 IF NHCUCHK'>0
Begin DoDot:1
+11 KILL HISTORY
+12 DO BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
+13 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+14 DO ENTIRE^VAFHADT4(+NHCUPIVT)
End DoDot:1
GOTO MEDICAL
+15 IF NHCUCHK>0
Begin DoDot:1
+16 SET TRANSFER=$ORDER(VAFH(2,0))
+17 SET TRNSNODE=VAFH(2,TRANSFER,"A")
+18 DO BLDMSG^VAFHADT2(DFN,"A02",$PIECE(TRNSNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
+19 SET PSUEDO=$ORDER(VAFH(3,0))
+20 SET PSUNODE=VAFH(3,PSUEDO,"A")
+21 DO BLDMSG^VAFHADT2(DFN,"A03",$PIECE(PSUNODE,"^",1),"05",PSUEDO,+NHCUPIVT)
End DoDot:1
MEDICAL ;
+1 DO BLDMSG^VAFHADT2(DFN,"A01",$PIECE(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
+2 QUIT
+3 ;
14(DFN) ;
+1 NEW NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN,TRANNODE,NHCUDIS,DISNODE
+2 SET NHCUADMT=$ORDER(VAFH(1,0))
+3 SET NHCUNODE=VAFH(1,NHCUADMT,"A")
+4 SET NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+5 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+6 IF +NHCUCHK'>0
Begin DoDot:1
+7 KILL HISTORY
+8 DO BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
+9 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+10 DO ENTIRE^VAFHADT4(+NHCUPIVT)
End DoDot:1
QUIT
+11 SET NHCUDIS=$ORDER(VAFH(3,0))
+12 SET DISNODE=VAFH(3,NHCUDIS,"P")
+13 DO BLDMSG^VAFHADT2(DFN,"A13",$PIECE(DISNODE,"^",1),"05",NHCUDIS,+NHCUPIVT)
+14 SET NHCUTRAN=$ORDER(VAFH(2,0))
+15 SET TRANNODE=VAFH(2,NHCUTRAN,"A")
+16 DO BLDMSG^VAFHADT2(DFN,"A02",$PIECE(TRANNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
+17 QUIT
+18 ;
41(DFN) ;
+1 NEW NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,MEDADMT,MEDNODE,MEDPIVT,MEDCHK,NHCUPREV
+2 SET NHCUADMT=$ORDER(VAFH(1,0))
+3 SET NHCUNODE=VAFH(1,NHCUADMT,"A")
+4 SET NHCUPREV=VAFH(1,NHCUADMT,"P")
+5 SET MEDADMT=$ORDER(VAFH(1,NHCUADMT))
+6 SET MEDNODE=VAFH(1,MEDADMT,"A")
+7 SET NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+8 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+9 SET MEDCHK=$$PIVCHK^VAFHPIVT(DFN,$PIECE(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
+10 SET MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
+11 IF +MEDCHK>0
DO BLDMSG^VAFHADT2(DFN,"A03",$PIECE(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
+12 IF +MEDCHK'>0
Begin DoDot:1
+13 KILL HISTORY
+14 DO BLDHIST^VAFHADT3(DFN,MEDADMT,"HISTORY")
+15 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+16 DO ENTIRE^VAFHADT4(+MEDPIVT)
End DoDot:1
+17 IF +NHCUCHK>0
Begin DoDot:1
+18 SET NHCUDSDT=$PIECE(VAFH(3,$PIECE(NHCUPREV,"^",17),"P"),"^",1)
+19 DO BLDMSG^VAFHADT2(DFN,"A13",NHCUDSDT,"05",NHCUADMT,+NHCUPIVT)
+20 DO BLDMSG^VAFHADT2(DFN,"A02",$PIECE(DGPMA,"^",1),"05",NHCUADMT,+NHCUPIVT)
End DoDot:1
+21 IF +NHCUCHK'>0
Begin DoDot:1
+22 KILL HISTORY
+23 DO BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
+24 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+25 DO ENTIRE^VAFHADT4(+NHCUPIVT)
End DoDot:1
+26 QUIT
43(DFN) ;
+1 NEW NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN,TRANNODE,NHCUDIS,DISNODE
+2 SET NHCUADMT=$ORDER(VAFH(1,0))
+3 SET NHCUNODE=VAFH(1,NHCUADMT,"A")
+4 SET NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+5 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
+6 IF +NHCUCHK'>0
Begin DoDot:1
+7 KILL HISTORY
+8 DO BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
+9 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+10 DO ENTIRE^VAFHADT4(+NHCUPIVT)
End DoDot:1
QUIT
+11 SET NHCUTRAN=$ORDER(VAFH(2,0))
+12 SET TRANNODE=VAFH(2,NHCUTRAN,"A")
+13 DO BLDMSG^VAFHADT2(DFN,"A02",$PIECE(TRANNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
+14 SET NHCUDIS=$ORDER(VAFH(3,0))
+15 SET DISNODE=VAFH(3,NHCUDIS,"A")
+16 DO BLDMSG^VAFHADT2(DFN,"A03",$PIECE(DISNODE,"^",1),"05",NHCUDIS,+NHCUPIVT)
+17 QUIT
44(DFN) ;
+1 NEW NHCUADMT,NHCUNODE,MEDADMT,MEDNODE,NHCUCHK,NHCUPIVT,MEDPIVT
+2 NEW TRANSFER,TRANNODE
+3 SET MEDADMT=$ORDER(VAFH(1,0))
+4 SET MEDNODE=VAFH(1,MEDADMT,"A")
+5 SET TRANSFER=$ORDER(VAFH(2,0))
+6 SET TRANNODE=VAFH(2,TRANSFER,"A")
+7 SET NHCUADMT=$PIECE(TRANNODE,"^",14)
+8 SET NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
+9 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
+10 SET MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
+11 IF +NHCUCHK'>0
Begin DoDot:1
+12 KILL HISTORY
+13 DO BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
+14 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+15 DO ENTIRE^VAFHADT4(+NHCUPIVT)
End DoDot:1
+16 IF +NHCUCHK>0
DO BLDMSG^VAFHADT2(DFN,"A02",$PIECE(TRANNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
+17 DO BLDMSG^VAFHADT2(DFN,"A01",$PIECE(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
+18 QUIT
+19 ;
46(DFN) ;
+1 NEW NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN
+2 NEW MEDADMT,MEDNODE,MEDDIS,MEDPIVT,DISNODE
+3 SET NHCUTRAN=$ORDER(VAFH(2,0))
+4 SET NHCUNODE=VAFH(2,NHCUTRAN,"A")
+5 SET NHCUADMT=$PIECE(VAFH(2,NHCUTRAN,"A"),"^",14)
+6 SET NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
+7 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
+8 IF +NHCUCHK'>0
Begin DoDot:1
+9 KILL HISTORY
+10 DO BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
+11 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+12 DO ENTIRE^VAFHADT4(+NHCUPIVT)
End DoDot:1
+13 IF +NHCUCHK>0
DO BLDMSG^VAFHADT2(DFN,"A02",$PIECE(NHCUNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
+14 SET MEDADMT=$ORDER(VAFH(1,0))
+15 SET MEDNODE=VAFH(1,MEDADMT,"A")
+16 SET MEDCHK=$$PIVCHK^VAFHPIVT(DFN,$PIECE(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
+17 SET MEDDIS=$ORDER(VAFH(3,0))
+18 SET DISNODE=VAFH(3,MEDDIS,"A")
+19 SET MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$PIECE(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
+20 IF +MEDCHK>0
DO BLDMSG^VAFHADT2(DFN,"A03",$PIECE(DISNODE,"^",1),"05",MEDDIS,+MEDPIVT)
+21 IF +MEDCHK'>0
Begin DoDot:1
+22 KILL HISTORY
+23 DO BLDHIST^VAFHADT3(DFN,MEDADMT,"HISTORY")
+24 if $DATA(VATRACE)
DO HISTORY^VAFHADT4
+25 DO ENTIRE^VAFHADT4(+MEDPIVT)
End DoDot:1
+26 QUIT
