- VAFCADT5 ;ALB/RJS - HL7 ADT BREAKOUT OF VAFCADT1 - APRIL 13,1995
- ;;5.3;Registration;**91**;Jun 06, 1996
- ;
- ;This routine was broken out of routine VAFCADT1 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^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+NHCUPIVT)
- I NHCUCHK>0 D
- . S TRANSFER=$O(VAFH(2,0))
- . S TRNSNODE=VAFH(2,TRANSFER,"A")
- . D BLDMSG^VAFCADT2(DFN,"A02",$P(TRNSNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
- . S PSUEDO=$O(VAFH(3,0))
- . S PSUNODE=VAFH(3,PSUEDO,"A")
- . D BLDMSG^VAFCADT2(DFN,"A03",$P(PSUNODE,"^",1),"05",PSUEDO,+NHCUPIVT)
- MEDICAL ;
- D BLDMSG^VAFCADT2(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^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+NHCUPIVT)
- S NHCUDIS=$O(VAFH(3,0))
- S DISNODE=VAFH(3,NHCUDIS,"P")
- D BLDMSG^VAFCADT2(DFN,"A13",$P(DISNODE,"^",1),"05",NHCUDIS,+NHCUPIVT)
- S NHCUTRAN=$O(VAFH(2,0))
- S TRANNODE=VAFH(2,NHCUTRAN,"A")
- D BLDMSG^VAFCADT2(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^VAFCADT2(DFN,"A03",$P(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
- I +MEDCHK'>0 D
- . K HISTORY
- . D BLDHIST^VAFCADT3(DFN,MEDADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+MEDPIVT)
- I +NHCUCHK>0 D
- . S NHCUDSDT=$P(VAFH(3,$P(NHCUPREV,"^",17),"P"),"^",1)
- . D BLDMSG^VAFCADT2(DFN,"A13",NHCUDSDT,"05",NHCUADMT,+NHCUPIVT)
- . D BLDMSG^VAFCADT2(DFN,"A02",$P(DGPMA,"^",1),"05",NHCUADMT,+NHCUPIVT)
- I +NHCUCHK'>0 D
- . K HISTORY
- . D BLDHIST^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+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^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+NHCUPIVT)
- S NHCUTRAN=$O(VAFH(2,0))
- S TRANNODE=VAFH(2,NHCUTRAN,"A")
- D BLDMSG^VAFCADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
- S NHCUDIS=$O(VAFH(3,0))
- S DISNODE=VAFH(3,NHCUDIS,"A")
- D BLDMSG^VAFCADT2(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^VAFCADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
- S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
- S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
- I +NHCUCHK'>0 D
- . K HISTORY
- . D BLDHIST^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+NHCUPIVT)
- I +NHCUCHK>0 D BLDMSG^VAFCADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
- D BLDMSG^VAFCADT2(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^VAFCADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
- S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
- I +NHCUCHK'>0 D
- . K HISTORY
- . D BLDHIST^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+NHCUPIVT)
- I +NHCUCHK>0 D BLDMSG^VAFCADT2(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^VAFCADT2(DFN,"A03",$P(DISNODE,"^",1),"05",MEDDIS,+MEDPIVT)
- I +MEDCHK'>0 D
- . K HISTORY
- . D BLDHIST^VAFCADT3(DFN,MEDADMT,"HISTORY")
- . D:$D(VATRACE) HISTORY^VAFCADT4
- . D ENTIRE^VAFCADT4(+MEDPIVT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCADT5 5687 printed Jan 18, 2025@04:02:12 Page 2
- VAFCADT5 ;ALB/RJS - HL7 ADT BREAKOUT OF VAFCADT1 - APRIL 13,1995
- +1 ;;5.3;Registration;**91**;Jun 06, 1996
- +2 ;
- +3 ;This routine was broken out of routine VAFCADT1 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^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- +13 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +14 DO ENTIRE^VAFCADT4(+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^VAFCADT2(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^VAFCADT2(DFN,"A03",$PIECE(PSUNODE,"^",1),"05",PSUEDO,+NHCUPIVT)
- End DoDot:1
- MEDICAL ;
- +1 DO BLDMSG^VAFCADT2(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^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- +9 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +10 DO ENTIRE^VAFCADT4(+NHCUPIVT)
- End DoDot:1
- QUIT
- +11 SET NHCUDIS=$ORDER(VAFH(3,0))
- +12 SET DISNODE=VAFH(3,NHCUDIS,"P")
- +13 DO BLDMSG^VAFCADT2(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^VAFCADT2(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^VAFCADT2(DFN,"A03",$PIECE(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
- +12 IF +MEDCHK'>0
- Begin DoDot:1
- +13 KILL HISTORY
- +14 DO BLDHIST^VAFCADT3(DFN,MEDADMT,"HISTORY")
- +15 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +16 DO ENTIRE^VAFCADT4(+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^VAFCADT2(DFN,"A13",NHCUDSDT,"05",NHCUADMT,+NHCUPIVT)
- +20 DO BLDMSG^VAFCADT2(DFN,"A02",$PIECE(DGPMA,"^",1),"05",NHCUADMT,+NHCUPIVT)
- End DoDot:1
- +21 IF +NHCUCHK'>0
- Begin DoDot:1
- +22 KILL HISTORY
- +23 DO BLDHIST^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- +24 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +25 DO ENTIRE^VAFCADT4(+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^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- +9 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +10 DO ENTIRE^VAFCADT4(+NHCUPIVT)
- End DoDot:1
- QUIT
- +11 SET NHCUTRAN=$ORDER(VAFH(2,0))
- +12 SET TRANNODE=VAFH(2,NHCUTRAN,"A")
- +13 DO BLDMSG^VAFCADT2(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^VAFCADT2(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^VAFCADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
- +9 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(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^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- +14 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +15 DO ENTIRE^VAFCADT4(+NHCUPIVT)
- End DoDot:1
- +16 IF +NHCUCHK>0
- DO BLDMSG^VAFCADT2(DFN,"A02",$PIECE(TRANNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
- +17 DO BLDMSG^VAFCADT2(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^VAFCADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
- +7 SET NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
- +8 IF +NHCUCHK'>0
- Begin DoDot:1
- +9 KILL HISTORY
- +10 DO BLDHIST^VAFCADT3(DFN,NHCUADMT,"HISTORY")
- +11 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +12 DO ENTIRE^VAFCADT4(+NHCUPIVT)
- End DoDot:1
- +13 IF +NHCUCHK>0
- DO BLDMSG^VAFCADT2(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^VAFCADT2(DFN,"A03",$PIECE(DISNODE,"^",1),"05",MEDDIS,+MEDPIVT)
- +21 IF +MEDCHK'>0
- Begin DoDot:1
- +22 KILL HISTORY
- +23 DO BLDHIST^VAFCADT3(DFN,MEDADMT,"HISTORY")
- +24 if $DATA(VATRACE)
- DO HISTORY^VAFCADT4
- +25 DO ENTIRE^VAFCADT4(+MEDPIVT)
- End DoDot:1
- +26 QUIT