VAFHADT4 ;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
;
INSERT(DFN,EVENT,VAFHDT,PIVOT) ;
I $$LASTONE(VAFHDT) D BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"05","",PIVOT) Q
D BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"04","",PIVOT)
I $$RECORD(VAFHDT)["ADMISSION" D BOTH(DFN,VAFHDT,PIVOT) Q
I $$RECORD(VAFHDT)["TRANSFER"&($$RECORD(VAFHDT)["SPECIALTY") D BOTH(DFN,VAFHDT,PIVOT) Q
I $$RECORD(VAFHDT)["TRANSFER" D TRANSFER(DFN,VAFHDT,PIVOT) Q
I $$RECORD(VAFHDT)["SPECIALTY" D SPECLTY(DFN,VAFHDT,PIVOT)
Q
;
;
DELETE(DFN,EVENT,VAFHDT,PIVOT,EVTYPE) ;
I $$LASTONE(VAFHDT) D BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"05","",PIVOT) Q
D BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"04","",PIVOT)
I EVTYPE=2.2 D BOTH(DFN,VAFHDT,PIVOT) Q
I EVTYPE=2.6 D SPECLTY(DFN,VAFHDT,PIVOT) Q
I EVTYPE=3.2 D BOTH(DFN,VAFHDT,PIVOT) Q
I EVTYPE=3.6 D SPECLTY(DFN,VAFHDT,PIVOT) Q
Q
;
;
BOTH(DFN,VAFHDT,PIVOT) ;
N FINISHED,FOUND1,FOUND2,RECORD
S (FINISHED,FOUND1,FOUND2)=0
F S VAFHDT=$O(HISTORY(VAFHDT)) Q:VAFHDT=""!(FINISHED) D
. S IEN=""
. F S IEN=$O(HISTORY(VAFHDT,IEN)) Q:IEN=""!(FINISHED) D
. . S RECORD=HISTORY(VAFHDT,IEN)
. . I RECORD["TRANSFER" S FOUND1=1
. . I RECORD["SPECIALTY" S FOUND2=1
. . I FOUND1&(FOUND2) S FINISHED=1 Q
. . I (RECORD["LASTONE") D BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"05",IEN,PIVOT) S FINISHED=1 Q
. . D BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"04","",PIVOT)
Q
;
;
TRANSFER(DFN,VAFHDT,PIVOT) ;
N FINISHED,RECORD S FINISHED=0
F S VAFHDT=$O(HISTORY(VAFHDT)) Q:VAFHDT=""!(FINISHED) D
. S IEN=""
. F S IEN=$O(HISTORY(VAFHDT,IEN)) Q:IEN=""!(FINISHED) D
. . S RECORD=HISTORY(VAFHDT,IEN)
. . I RECORD["TRANSFER" S FINISHED=1 Q
. . I (RECORD["LASTONE") D BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"05",IEN,PIVOT) S FINISHED=1 Q
. . D BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"04","",PIVOT)
Q
;
;
SPECLTY(DFN,VAFHDT,PIVOT) ;
N FINISHED,RECORD S FINISHED=0
F S VAFHDT=$O(HISTORY(VAFHDT)) Q:VAFHDT=""!(FINISHED) D
. S IEN=""
. F S IEN=$O(HISTORY(VAFHDT,IEN)) Q:IEN=""!(FINISHED) D
. . S RECORD=HISTORY(VAFHDT,IEN)
. . I RECORD["SPECIALTY" S FINISHED=1 Q
. . I (RECORD["LASTONE") D BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"05",IEN,PIVOT) S FINISHED=1 Q
. . D BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"04","",PIVOT)
Q
;
ENTIRE(PIVOT) ;
N VAFHDT,IEN,RECORD
S VAFHDT=""
F S VAFHDT=$O(HISTORY(VAFHDT)) Q:VAFHDT="" D
. S IEN="",EVCODE="04"
. F S IEN=$O(HISTORY(VAFHDT,IEN)) Q:IEN="" D
. . S RECORD=HISTORY(VAFHDT,IEN)
. . I RECORD["LASTONE" S EVCODE="05"
. . I RECORD["ADMISSION" D BLDMSG^VAFHADT2(DFN,"A01",VAFHDT,"05","",PIVOT) Q
. . I RECORD["TRANSFER" D BLDMSG^VAFHADT2(DFN,"A02",VAFHDT,EVCODE,"",PIVOT) Q
. . I RECORD["SPECIALTY" D BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,EVCODE,"",PIVOT) Q
. . I RECORD["DISCHARGE" D BLDMSG^VAFHADT2(DFN,"A03",VAFHDT,EVCODE,IEN,PIVOT) Q
Q
;
;
LASTONE(VAFHDT) ;
N IEN,RESULT,NEXTDATE S RESULT=0
S NEXTDATE=$O(HISTORY(VAFHDT))
I $G(NEXTDATE)="" S RESULT=1 G LASTEND
S IEN=$O(HISTORY(VAFHDT,""))
I $G(IEN)'="" D
. I HISTORY(VAFHDT,IEN)["LASTONE" S RESULT=1
LASTEND ;
Q RESULT
;
;
RECORD(VAFHDT) ;
N IEN
S IEN=$O(HISTORY(VAFHDT,""))
Q HISTORY(VAFHDT,IEN)
;
;
ADMDATE(IEN) ;
N RESULT
S RESULT=$P($G(^DGPM(IEN,0)),"^",1)
Q:$G(RESULT)="" 0
Q RESULT
HISTORY ;
N VAFHDT,IEN
S VAFHDT=""
F S VAFHDT=$O(HISTORY(VAFHDT)) Q:VAFHDT="" D
. S IEN=""
. F S IEN=$O(HISTORY(VAFHDT,IEN)) Q:IEN="" D
. . W !,VAFHDT," ---> ",HISTORY(VAFHDT,IEN)
Q
;
ADDING(DFN,EVENT,VAFHDT,PIVOT,PIVCHK) ;
I PIVCHK'>0 D ENTIRE(PIVOT) Q
D INSERT(DFN,EVENT,VAFHDT,PIVOT)
Q
;
PIVINIT(DFN,VAFHDATE,ADMSSN) ;
S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,VAFHDATE,1,ADMSSN_";DGPM(")
S PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDATE,1,ADMSSN_";DGPM(")
Q
;
SETVARS(NODE,DGPMDA) ;
S TYPE=$P(NODE,"^",2),VAFHDT=$P(NODE,"^",1),ADMSSN=$P(NODE,"^",14),IEN=DGPMDA Q
;
MOVETYPE(NODE) ;
N TYPE
S TYPE=$P(NODE,"^",18)
I TYPE>0 Q TYPE
Q 0
VAFHADT4 ;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 ;
INSERT(DFN,EVENT,VAFHDT,PIVOT) ;
+1 IF $$LASTONE(VAFHDT)
DO BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"05","",PIVOT)
QUIT
+2 DO BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"04","",PIVOT)
+3 IF $$RECORD(VAFHDT)["ADMISSION"
DO BOTH(DFN,VAFHDT,PIVOT)
QUIT
+4 IF $$RECORD(VAFHDT)["TRANSFER"&($$RECORD(VAFHDT)["SPECIALTY")
DO BOTH(DFN,VAFHDT,PIVOT)
QUIT
+5 IF $$RECORD(VAFHDT)["TRANSFER"
DO TRANSFER(DFN,VAFHDT,PIVOT)
QUIT
+6 IF $$RECORD(VAFHDT)["SPECIALTY"
DO SPECLTY(DFN,VAFHDT,PIVOT)
+7 QUIT
+8 ;
+9 ;
DELETE(DFN,EVENT,VAFHDT,PIVOT,EVTYPE) ;
+1 IF $$LASTONE(VAFHDT)
DO BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"05","",PIVOT)
QUIT
+2 DO BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"04","",PIVOT)
+3 IF EVTYPE=2.2
DO BOTH(DFN,VAFHDT,PIVOT)
QUIT
+4 IF EVTYPE=2.6
DO SPECLTY(DFN,VAFHDT,PIVOT)
QUIT
+5 IF EVTYPE=3.2
DO BOTH(DFN,VAFHDT,PIVOT)
QUIT
+6 IF EVTYPE=3.6
DO SPECLTY(DFN,VAFHDT,PIVOT)
QUIT
+7 QUIT
+8 ;
+9 ;
BOTH(DFN,VAFHDT,PIVOT) ;
+1 NEW FINISHED,FOUND1,FOUND2,RECORD
+2 SET (FINISHED,FOUND1,FOUND2)=0
+3 FOR
SET VAFHDT=$ORDER(HISTORY(VAFHDT))
IF VAFHDT=""!(FINISHED)
QUIT
Begin DoDot:1
+4 SET IEN=""
+5 FOR
SET IEN=$ORDER(HISTORY(VAFHDT,IEN))
IF IEN=""!(FINISHED)
QUIT
Begin DoDot:2
+6 SET RECORD=HISTORY(VAFHDT,IEN)
+7 IF RECORD["TRANSFER"
SET FOUND1=1
+8 IF RECORD["SPECIALTY"
SET FOUND2=1
+9 IF FOUND1&(FOUND2)
SET FINISHED=1
QUIT
+10 IF (RECORD["LASTONE")
DO BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"05",IEN,PIVOT)
SET FINISHED=1
QUIT
+11 DO BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"04","",PIVOT)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;
TRANSFER(DFN,VAFHDT,PIVOT) ;
+1 NEW FINISHED,RECORD
SET FINISHED=0
+2 FOR
SET VAFHDT=$ORDER(HISTORY(VAFHDT))
IF VAFHDT=""!(FINISHED)
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(HISTORY(VAFHDT,IEN))
IF IEN=""!(FINISHED)
QUIT
Begin DoDot:2
+5 SET RECORD=HISTORY(VAFHDT,IEN)
+6 IF RECORD["TRANSFER"
SET FINISHED=1
QUIT
+7 IF (RECORD["LASTONE")
DO BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"05",IEN,PIVOT)
SET FINISHED=1
QUIT
+8 DO BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"04","",PIVOT)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ;
SPECLTY(DFN,VAFHDT,PIVOT) ;
+1 NEW FINISHED,RECORD
SET FINISHED=0
+2 FOR
SET VAFHDT=$ORDER(HISTORY(VAFHDT))
IF VAFHDT=""!(FINISHED)
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(HISTORY(VAFHDT,IEN))
IF IEN=""!(FINISHED)
QUIT
Begin DoDot:2
+5 SET RECORD=HISTORY(VAFHDT,IEN)
+6 IF RECORD["SPECIALTY"
SET FINISHED=1
QUIT
+7 IF (RECORD["LASTONE")
DO BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"05",IEN,PIVOT)
SET FINISHED=1
QUIT
+8 DO BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,"04","",PIVOT)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
ENTIRE(PIVOT) ;
+1 NEW VAFHDT,IEN,RECORD
+2 SET VAFHDT=""
+3 FOR
SET VAFHDT=$ORDER(HISTORY(VAFHDT))
IF VAFHDT=""
QUIT
Begin DoDot:1
+4 SET IEN=""
SET EVCODE="04"
+5 FOR
SET IEN=$ORDER(HISTORY(VAFHDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+6 SET RECORD=HISTORY(VAFHDT,IEN)
+7 IF RECORD["LASTONE"
SET EVCODE="05"
+8 IF RECORD["ADMISSION"
DO BLDMSG^VAFHADT2(DFN,"A01",VAFHDT,"05","",PIVOT)
QUIT
+9 IF RECORD["TRANSFER"
DO BLDMSG^VAFHADT2(DFN,"A02",VAFHDT,EVCODE,"",PIVOT)
QUIT
+10 IF RECORD["SPECIALTY"
DO BLDMSG^VAFHADT2(DFN,"A08",VAFHDT,EVCODE,"",PIVOT)
QUIT
+11 IF RECORD["DISCHARGE"
DO BLDMSG^VAFHADT2(DFN,"A03",VAFHDT,EVCODE,IEN,PIVOT)
QUIT
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;
LASTONE(VAFHDT) ;
+1 NEW IEN,RESULT,NEXTDATE
SET RESULT=0
+2 SET NEXTDATE=$ORDER(HISTORY(VAFHDT))
+3 IF $GET(NEXTDATE)=""
SET RESULT=1
GOTO LASTEND
+4 SET IEN=$ORDER(HISTORY(VAFHDT,""))
+5 IF $GET(IEN)'=""
Begin DoDot:1
+6 IF HISTORY(VAFHDT,IEN)["LASTONE"
SET RESULT=1
End DoDot:1
LASTEND ;
+1 QUIT RESULT
+2 ;
+3 ;
RECORD(VAFHDT) ;
+1 NEW IEN
+2 SET IEN=$ORDER(HISTORY(VAFHDT,""))
+3 QUIT HISTORY(VAFHDT,IEN)
+4 ;
+5 ;
ADMDATE(IEN) ;
+1 NEW RESULT
+2 SET RESULT=$PIECE($GET(^DGPM(IEN,0)),"^",1)
+3 IF $GET(RESULT)=""
QUIT 0
+4 QUIT RESULT
HISTORY ;
+1 NEW VAFHDT,IEN
+2 SET VAFHDT=""
+3 FOR
SET VAFHDT=$ORDER(HISTORY(VAFHDT))
IF VAFHDT=""
QUIT
Begin DoDot:1
+4 SET IEN=""
+5 FOR
SET IEN=$ORDER(HISTORY(VAFHDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+6 WRITE !,VAFHDT," ---> ",HISTORY(VAFHDT,IEN)
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
ADDING(DFN,EVENT,VAFHDT,PIVOT,PIVCHK) ;
+1 IF PIVCHK'>0
DO ENTIRE(PIVOT)
QUIT
+2 DO INSERT(DFN,EVENT,VAFHDT,PIVOT)
+3 QUIT
+4 ;
PIVINIT(DFN,VAFHDATE,ADMSSN) ;
+1 SET PIVCHK=$$PIVCHK^VAFHPIVT(DFN,VAFHDATE,1,ADMSSN_";DGPM(")
+2 SET PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDATE,1,ADMSSN_";DGPM(")
+3 QUIT
+4 ;
SETVARS(NODE,DGPMDA) ;
+1 SET TYPE=$PIECE(NODE,"^",2)
SET VAFHDT=$PIECE(NODE,"^",1)
SET ADMSSN=$PIECE(NODE,"^",14)
SET IEN=DGPMDA
QUIT
+2 ;
MOVETYPE(NODE) ;
+1 NEW TYPE
+2 SET TYPE=$PIECE(NODE,"^",18)
+3 IF TYPE>0
QUIT TYPE
+4 QUIT 0
