PXCEHIST ;ISL/dee - Used to add an historical visit and display a visit ;9/5/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,22**;Aug 12, 1996
;; ;
Q
;
;Line with the line label "FORMAT"
;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name
; 1 2 3 4 5
;
;Following lines:
;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
;The Display & Edit routines are for special cases.
;
FORMAT ;;Historical Encounter~9000010~0,21,150,800,811,812~~^AUPNVSIT
;;0~1~.01~Encounter Date and (optional) Time: ~Encounter Date and Time: ~~EVISITDT^PXCEHIST(-1)~~~B
;;0~5~.05~Patient Name: ~Patient Name: ~~EPAT^PXCEVSIT~~~D
;;0~6~.06~Location of Encounter: ~Location of Encounter: ~~ELOC^PXCEHIST~~~D
;;811~1~81101~Comment: ~Comment: ~~~~~D
;;
;
;********************************
;Special cases for display of visit are in PXCEVSIT.
;
;********************************
;Special cases for edit of visit are in PXCEVSIT and below.
;
EVISITDT(DTPARM) ;
I $P(PXCEAFTR(0),"^",1)']"" D
. D EVISITDT^PXCEVSIT(DTPARM)
E S (X,Y)=$P(PXCEAFTR(0),"^",1)
Q
;
ELOC ;Used to edit location of the visit for historical visits
;Ask if it is a location outside the VA
S DIR(0)="YA"
S DIR("A")="Is this a VA location? "
I $P(PXCEAFTR(0),"^",6)]"" S DIR("B")="Y"
E I $P(PXCEAFTR(21),"^",1)]"" S DIR("B")="N"
E S DIR("B")="N"
D ^DIR
K DIR,DA
I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit
I Y S INOROUT="I" G IN
E S INOROUT="O" G OUT
;
IN ;This is a va location
N DIERR,PXCEDILF,PXCEINT,PXCEEXT
I $P(PXCEAFTR(0),"^",6)'="" S PXCEINT=$P(PXCEAFTR(0),"^",6)
E S PXCEINT=+$$SITE^VASITE(+PXCEAFTR(0)) ;default to this site
S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,.06,"",PXCEINT,"PXCEDILF")
S DIR("B")=$S('$D(DIERR)&PXCEEXT]"":PXCEEXT,1:PXCEINT)
S DIR(0)="9000010,.06A"
S DIR("A")=$P(PXCETEXT,"~",4)
S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
D ^DIR
K DIR,DA
I X="@" S Y="@"
E I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit
;
S $P(PXCEAFTR(0),"^",6)=$P(Y,"^")
S $P(PXCEAFTR(21),"^",1)=""
S $P(PXCEAFTR(0),"^",3)="V"
G FINISH
;
OUT ;This is a non va location
I $P(PXCEAFTR(21),"^",1)'="" D
. S DIR("B")=$P(PXCEAFTR(21),"^",1)
S DIR(0)="9000010,2101A"
S DIR("A")="Non VA Location of Encounter? "
D ^DIR
K DIR,DA
I X="@" S Y="@"
E I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit
;
S $P(PXCEAFTR(21),"^",1)=$P(Y,"^")
S $P(PXCEAFTR(0),"^",6)=""
S $P(PXCEAFTR(0),"^",3)="O"
FINISH ;
S $P(PXCEAFTR(0),"^",7)="E"
S $P(PXCEAFTR(0),"^",22)=""
Q
;
;********************************
;Display text for the .01 field which is a Date and Time.
;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
DISPLY01(PXCEVSIT) ;
Q $$DISPLY01^PXCESIT(PXCEVSIT)
;
PXCEHIST ;ISL/dee - Used to add an historical visit and display a visit ;9/5/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,22**;Aug 12, 1996
+2 ;; ;
+3 QUIT
+4 ;
+5 ;Line with the line label "FORMAT"
+6 ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name
+7 ; 1 2 3 4 5
+8 ;
+9 ;Following lines:
+10 ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
+11 ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
+12 ;The Display & Edit routines are for special cases.
+13 ;
FORMAT ;;Historical Encounter~9000010~0,21,150,800,811,812~~^AUPNVSIT
+1 ;;0~1~.01~Encounter Date and (optional) Time: ~Encounter Date and Time: ~~EVISITDT^PXCEHIST(-1)~~~B
+2 ;;0~5~.05~Patient Name: ~Patient Name: ~~EPAT^PXCEVSIT~~~D
+3 ;;0~6~.06~Location of Encounter: ~Location of Encounter: ~~ELOC^PXCEHIST~~~D
+4 ;;811~1~81101~Comment: ~Comment: ~~~~~D
+5 ;;
+6 ;
+7 ;********************************
+8 ;Special cases for display of visit are in PXCEVSIT.
+9 ;
+10 ;********************************
+11 ;Special cases for edit of visit are in PXCEVSIT and below.
+12 ;
EVISITDT(DTPARM) ;
+1 IF $PIECE(PXCEAFTR(0),"^",1)']""
Begin DoDot:1
+2 DO EVISITDT^PXCEVSIT(DTPARM)
End DoDot:1
+3 IF '$TEST
SET (X,Y)=$PIECE(PXCEAFTR(0),"^",1)
+4 QUIT
+5 ;
ELOC ;Used to edit location of the visit for historical visits
+1 ;Ask if it is a location outside the VA
+2 SET DIR(0)="YA"
+3 SET DIR("A")="Is this a VA location? "
+4 IF $PIECE(PXCEAFTR(0),"^",6)]""
SET DIR("B")="Y"
+5 IF '$TEST
IF $PIECE(PXCEAFTR(21),"^",1)]""
SET DIR("B")="N"
+6 IF '$TEST
SET DIR("B")="N"
+7 DO ^DIR
+8 KILL DIR,DA
+9 ;for visit
IF $DATA(DTOUT)!$DATA(DUOUT)
SET (PXCEEND,PXCEQUIT)=1
QUIT
+10 IF Y
SET INOROUT="I"
GOTO IN
+11 IF '$TEST
SET INOROUT="O"
GOTO OUT
+12 ;
IN ;This is a va location
+1 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+2 IF $PIECE(PXCEAFTR(0),"^",6)'=""
SET PXCEINT=$PIECE(PXCEAFTR(0),"^",6)
+3 ;default to this site
IF '$TEST
SET PXCEINT=+$$SITE^VASITE(+PXCEAFTR(0))
+4 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,.06,"",PXCEINT,"PXCEDILF")
+5 SET DIR("B")=$SELECT('$DATA(DIERR)&PXCEEXT]"":PXCEEXT,1:PXCEINT)
+6 SET DIR(0)="9000010,.06A"
+7 SET DIR("A")=$PIECE(PXCETEXT,"~",4)
+8 IF $PIECE(PXCETEXT,"~",8)]""
SET DIR("?")=$PIECE(PXCETEXT,"~",8)
+9 DO ^DIR
+10 KILL DIR,DA
+11 IF X="@"
SET Y="@"
+12 ;for visit
IF '$TEST
IF $DATA(DTOUT)!$DATA(DUOUT)
SET (PXCEEND,PXCEQUIT)=1
QUIT
+13 ;
+14 SET $PIECE(PXCEAFTR(0),"^",6)=$PIECE(Y,"^")
+15 SET $PIECE(PXCEAFTR(21),"^",1)=""
+16 SET $PIECE(PXCEAFTR(0),"^",3)="V"
+17 GOTO FINISH
+18 ;
OUT ;This is a non va location
+1 IF $PIECE(PXCEAFTR(21),"^",1)'=""
Begin DoDot:1
+2 SET DIR("B")=$PIECE(PXCEAFTR(21),"^",1)
End DoDot:1
+3 SET DIR(0)="9000010,2101A"
+4 SET DIR("A")="Non VA Location of Encounter? "
+5 DO ^DIR
+6 KILL DIR,DA
+7 IF X="@"
SET Y="@"
+8 ;for visit
IF '$TEST
IF $DATA(DTOUT)!$DATA(DUOUT)
SET (PXCEEND,PXCEQUIT)=1
QUIT
+9 ;
+10 SET $PIECE(PXCEAFTR(21),"^",1)=$PIECE(Y,"^")
+11 SET $PIECE(PXCEAFTR(0),"^",6)=""
+12 SET $PIECE(PXCEAFTR(0),"^",3)="O"
FINISH ;
+1 SET $PIECE(PXCEAFTR(0),"^",7)="E"
+2 SET $PIECE(PXCEAFTR(0),"^",22)=""
+3 QUIT
+4 ;
+5 ;********************************
+6 ;Display text for the .01 field which is a Date and Time.
+7 ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
DISPLY01(PXCEVSIT) ;
+1 QUIT $$DISPLY01^PXCESIT(PXCEVSIT)
+2 ;
