AUPNVSIT ;OHPRD/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) ;10/25/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**204**;Aug 12, 1996;Build 14
;
; Patch PX*1*204 changes the 2nd line of this routine to reflect the
; incorporation of the module into PCE. For historical reference,
; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
; patches. This is the same as what patch PX*1*76 did for the VSIT* routines.
;
;;2.0;VISIT TRACKING;**1**;Aug 12, 1996
;;93.2;IHS PATIENT DICTIONARIES.;;JUL 01, 1993
;
VSIT01 ;EP;9000010,.01 (VISIT,VISIT/ADMIT DATE&TIME)
I '$D(AUPNPAT) W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <No direct entry allowed>" K X Q
I $D(AUPNDOB),$D(AUPNDOD),AUPNDOB,$D(DT),DT D VSIT01B Q
I '$D(AUPNTALK),'$D(ZTQUEUED) W " <Required variables do not exist>"
K X
Q
VSIT01B ;
I DT_".9999"<X W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Future dates not allowed>" K X Q
I DUZ("AG")="I",AUPNDOD,$P(X,".",1)>AUPNDOD W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Patient died before this date>" K X Q
I $P(X,".",1)<AUPNDOB W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Patient born after this date>" K X Q
Q
;
POSTSLCT ;
S AUPNVSIT=+Y,AUPNY=Y
I '$D(AUPNPAT),$P(^AUPNVSIT(AUPNVSIT,0),U,5) S Y=$P(^(0),U,5) D ^AUPNPAT
S Y=AUPNY K AUPNY
Q
;
ADD ; ADD TO DEPENDENCY COUNT
S ^XTMP("AUPNVSIT",0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"section ADD of AUPNVSIT and section KILL of VSITKIL communication",^XTMP("AUPNVSIT",X)=1 ;PX*1*204 - added
I '($D(^AUPNVSIT(X,0))#2) K ^XTMP("AUPNVSIT",X) Q ;PX*1*204 added kill of ^XTMP
L +^AUPNVSIT(X,0):60 ;E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
S:$P(^AUPNVSIT(X,0),U,9)<0 $P(^(0),U,9)=0
S $P(^AUPNVSIT(X,0),U,9)=$P(^AUPNVSIT(X,0),U,9)+1 ;,$P(^(0),U,11)="" ;*** WILL NOT UNDELETE ***
;The next two lines are not used in the VA
;I $D(^AUPNVSIT("AMFI",X)),^AUPNVSIT("AMFI",X)="M"
;E I DUZ'=".5",$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(X,0),U,15)'="A",$P(^(0),U,15)'="D" S $P(^AUPNVSIT(X,0),U,15)="M",^AUPNVSIT("AMFI",X)="M"
L -^AUPNVSIT(X,0)
K ^XTMP("AUPNVSIT",X) ;PX*1*204 - added
Q
SUB ; SUBTRACT FROM DEPENDENCY COUNT
Q:'($D(^AUPNVSIT(X,0))#2)
L +^AUPNVSIT(X,0):60 ;E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
S $P(^AUPNVSIT(X,0),U,9)=$P(^AUPNVSIT(X,0),U,9)-1 ;S:$P(^(0),U,9)<1 $P(^(0),U,11)=1 *** DON'T DELETE ***
I $P(^AUPNVSIT(X,0),U,9)<0 S $P(^(0),U,9)=0 ; Should not happen but does
;The next two lines are not used in the VA
;I $P(^AUPNVSIT(X,0),U,15)="A"
;E I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V" S $P(^AUPNVSIT(X,0),U,15)="D",^AUPNVSIT("AMFI",X)="D"
L -^AUPNVSIT(X,0)
Q
;
MOD ;EP;MODIFY A VISIT OR V FILE ENTRY
;*******CANNOT BE CALLED FROM DIE **********CALLS DIE
N X I X ;this line was added so that it will error if this entry is ever called so that you will know that this code was commented out for the VA.
;S DA=AUPNVSIT,DIE="^AUPNVSIT(",DR=".13////"_DT D ^DIE K DA,DIE,DIU,DIV,DR
;the following updates MFI information **** NOT DONE IN THE VA ****
;Q:'$D(^AUTTSITE(1,0))
;Q:$P(^AUTTSITE(1,0),U,16)'="V"
;Q:DUZ=.5
;I $P(^AUPNVSIT(AUPNVSIT,0),U,15)'="A",$P(^(0),U,15)'="D" S DR=".15///M",DA=AUPNVSIT,DIE="^AUPNVSIT(" D ^DIE
;K DIE,DA,DR,DIU,DIV
Q
;*******CANNOT BE CALLED FROM DIE**********CALLS DIE
DEL ;EP;*** EXTERNAL ENTRY POINT *** SET DELETE FLAG
N X I X ;this line was added so that it will error if this entry is ever called so that you will know that this code was commented out for the VA.
; The following exclusive NEW excepted from SAC by the Director, DSD. Request dated 12.14.92. No suspense was mandated.
;N (DT,DUZ,AUPNVSIT,U)
;I $P(^AUPNVSIT(AUPNVSIT,0),U,9) S AUPNVSIT=-1 Q
;S DIK="^AUPNVSIT(",DA=AUPNVSIT,X=2 D DD^DIK,1^DIK1
;S DA=AUPNVSIT,DR=".11///1",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR
;I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(AUPNVSIT,0),U,15)="A" S DA=AUPNVSIT,DR=".15///@",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR Q
;I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(AUPNVSIT,0),U,15)'="A" S DA=AUPNVSIT,DR=".15///D",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAUPNVSIT 4166 printed Nov 22, 2024@17:35:30 Page 2
AUPNVSIT ;OHPRD/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) ;10/25/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**204**;Aug 12, 1996;Build 14
+2 ;
+3 ; Patch PX*1*204 changes the 2nd line of this routine to reflect the
+4 ; incorporation of the module into PCE. For historical reference,
+5 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
+6 ; patches. This is the same as what patch PX*1*76 did for the VSIT* routines.
+7 ;
+8 ;;2.0;VISIT TRACKING;**1**;Aug 12, 1996
+9 ;;93.2;IHS PATIENT DICTIONARIES.;;JUL 01, 1993
+10 ;
VSIT01 ;EP;9000010,.01 (VISIT,VISIT/ADMIT DATE&TIME)
+1 IF '$DATA(AUPNPAT)
if '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
WRITE " <No direct entry allowed>"
KILL X
QUIT
+2 IF $DATA(AUPNDOB)
IF $DATA(AUPNDOD)
IF AUPNDOB
IF $DATA(DT)
IF DT
DO VSIT01B
QUIT
+3 IF '$DATA(AUPNTALK)
IF '$DATA(ZTQUEUED)
WRITE " <Required variables do not exist>"
+4 KILL X
+5 QUIT
VSIT01B ;
+1 IF DT_".9999"<X
if '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
WRITE " <Future dates not allowed>"
KILL X
QUIT
+2 IF DUZ("AG")="I"
IF AUPNDOD
IF $PIECE(X,".",1)>AUPNDOD
if '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
WRITE " <Patient died before this date>"
KILL X
QUIT
+3 IF $PIECE(X,".",1)<AUPNDOB
if '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
WRITE " <Patient born after this date>"
KILL X
QUIT
+4 QUIT
+5 ;
POSTSLCT ;
+1 SET AUPNVSIT=+Y
SET AUPNY=Y
+2 IF '$DATA(AUPNPAT)
IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,5)
SET Y=$PIECE(^(0),U,5)
DO ^AUPNPAT
+3 SET Y=AUPNY
KILL AUPNY
+4 QUIT
+5 ;
ADD ; ADD TO DEPENDENCY COUNT
+1 ;PX*1*204 - added
SET ^XTMP("AUPNVSIT",0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"section ADD of AUPNVSIT and section KILL of VSITKIL communication"
SET ^XTMP("AUPNVSIT",X)=1
+2 ;PX*1*204 added kill of ^XTMP
IF '($DATA(^AUPNVSIT(X,0))#2)
KILL ^XTMP("AUPNVSIT",X)
QUIT
+3 ;E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
LOCK +^AUPNVSIT(X,0):60
+4 if $PIECE(^AUPNVSIT(X,0),U,9)<0
SET $PIECE(^(0),U,9)=0
+5 ;,$P(^(0),U,11)="" ;*** WILL NOT UNDELETE ***
SET $PIECE(^AUPNVSIT(X,0),U,9)=$PIECE(^AUPNVSIT(X,0),U,9)+1
+6 ;The next two lines are not used in the VA
+7 ;I $D(^AUPNVSIT("AMFI",X)),^AUPNVSIT("AMFI",X)="M"
+8 ;E I DUZ'=".5",$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(X,0),U,15)'="A",$P(^(0),U,15)'="D" S $P(^AUPNVSIT(X,0),U,15)="M",^AUPNVSIT("AMFI",X)="M"
+9 LOCK -^AUPNVSIT(X,0)
+10 ;PX*1*204 - added
KILL ^XTMP("AUPNVSIT",X)
+11 QUIT
SUB ; SUBTRACT FROM DEPENDENCY COUNT
+1 if '($DATA(^AUPNVSIT(X,0))#2)
QUIT
+2 ;E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
LOCK +^AUPNVSIT(X,0):60
+3 ;S:$P(^(0),U,9)<1 $P(^(0),U,11)=1 *** DON'T DELETE ***
SET $PIECE(^AUPNVSIT(X,0),U,9)=$PIECE(^AUPNVSIT(X,0),U,9)-1
+4 ; Should not happen but does
IF $PIECE(^AUPNVSIT(X,0),U,9)<0
SET $PIECE(^(0),U,9)=0
+5 ;The next two lines are not used in the VA
+6 ;I $P(^AUPNVSIT(X,0),U,15)="A"
+7 ;E I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V" S $P(^AUPNVSIT(X,0),U,15)="D",^AUPNVSIT("AMFI",X)="D"
+8 LOCK -^AUPNVSIT(X,0)
+9 QUIT
+10 ;
MOD ;EP;MODIFY A VISIT OR V FILE ENTRY
+1 ;*******CANNOT BE CALLED FROM DIE **********CALLS DIE
+2 ;this line was added so that it will error if this entry is ever called so that you will know that this code was commented out for the VA.
NEW X
IF X
+3 ;S DA=AUPNVSIT,DIE="^AUPNVSIT(",DR=".13////"_DT D ^DIE K DA,DIE,DIU,DIV,DR
+4 ;the following updates MFI information **** NOT DONE IN THE VA ****
+5 ;Q:'$D(^AUTTSITE(1,0))
+6 ;Q:$P(^AUTTSITE(1,0),U,16)'="V"
+7 ;Q:DUZ=.5
+8 ;I $P(^AUPNVSIT(AUPNVSIT,0),U,15)'="A",$P(^(0),U,15)'="D" S DR=".15///M",DA=AUPNVSIT,DIE="^AUPNVSIT(" D ^DIE
+9 ;K DIE,DA,DR,DIU,DIV
+10 QUIT
+11 ;*******CANNOT BE CALLED FROM DIE**********CALLS DIE
DEL ;EP;*** EXTERNAL ENTRY POINT *** SET DELETE FLAG
+1 ;this line was added so that it will error if this entry is ever called so that you will know that this code was commented out for the VA.
NEW X
IF X
+2 ; The following exclusive NEW excepted from SAC by the Director, DSD. Request dated 12.14.92. No suspense was mandated.
+3 ;N (DT,DUZ,AUPNVSIT,U)
+4 ;I $P(^AUPNVSIT(AUPNVSIT,0),U,9) S AUPNVSIT=-1 Q
+5 ;S DIK="^AUPNVSIT(",DA=AUPNVSIT,X=2 D DD^DIK,1^DIK1
+6 ;S DA=AUPNVSIT,DR=".11///1",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR
+7 ;I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(AUPNVSIT,0),U,15)="A" S DA=AUPNVSIT,DR=".15///@",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR Q
+8 ;I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(AUPNVSIT,0),U,15)'="A" S DA=AUPNVSIT,DR=".15///D",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR Q
+9 QUIT
