Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCADT5

VAFCADT5.m

Go to the documentation of this file.
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