source: WorldVistAEHR/trunk/r/IHS_ROUTINES-AUP/AUPNVSIT.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1AUPNVSIT ;OHPRD/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) ;10/25/96
2 ;;2.0;VISIT TRACKING;**1**;Aug 12, 1996
3 ;;93.2;IHS PATIENT DICTIONARIES.;;JUL 01, 1993
4 ;
5VSIT01 ;EP;9000010,.01 (VISIT,VISIT/ADMIT DATE&TIME)
6 I '$D(AUPNPAT) W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <No direct entry allowed>" K X Q
7 I $D(AUPNDOB),$D(AUPNDOD),AUPNDOB,$D(DT),DT D VSIT01B Q
8 I '$D(AUPNTALK),'$D(ZTQUEUED) W " <Required variables do not exist>"
9 K X
10 Q
11VSIT01B ;
12 I DT_".9999"<X W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Future dates not allowed>" K X Q
13 I DUZ("AG")="I",AUPNDOD,$P(X,".",1)>AUPNDOD W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Patient died before this date>" K X Q
14 I $P(X,".",1)<AUPNDOB W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Patient born after this date>" K X Q
15 Q
16 ;
17POSTSLCT ;
18 S AUPNVSIT=+Y,AUPNY=Y
19 I '$D(AUPNPAT),$P(^AUPNVSIT(AUPNVSIT,0),U,5) S Y=$P(^(0),U,5) D ^AUPNPAT
20 S Y=AUPNY K AUPNY
21 Q
22 ;
23ADD ; ADD TO DEPENDENCY COUNT
24 Q:'($D(^AUPNVSIT(X,0))#2)
25 L +^AUPNVSIT(X,0):60 ;E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
26 S:$P(^AUPNVSIT(X,0),U,9)<0 $P(^(0),U,9)=0
27 S $P(^AUPNVSIT(X,0),U,9)=$P(^AUPNVSIT(X,0),U,9)+1 ;,$P(^(0),U,11)="" ;*** WILL NOT UNDELETE ***
28 ;The next two lines are not used in the VA
29 ;I $D(^AUPNVSIT("AMFI",X)),^AUPNVSIT("AMFI",X)="M"
30 ;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"
31 L -^AUPNVSIT(X,0)
32 Q
33SUB ; SUBTRACT FROM DEPENDENCY COUNT
34 Q:'($D(^AUPNVSIT(X,0))#2)
35 L +^AUPNVSIT(X,0):60 ;E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
36 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 ***
37 I $P(^AUPNVSIT(X,0),U,9)<0 S $P(^(0),U,9)=0 ; Should not happen but does
38 ;The next two lines are not used in the VA
39 ;I $P(^AUPNVSIT(X,0),U,15)="A"
40 ;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"
41 L -^AUPNVSIT(X,0)
42 Q
43 ;
44MOD ;EP;MODIFY A VISIT OR V FILE ENTRY
45 ;*******CANNOT BE CALLED FROM DIE **********CALLS DIE
46 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.
47 ;S DA=AUPNVSIT,DIE="^AUPNVSIT(",DR=".13////"_DT D ^DIE K DA,DIE,DIU,DIV,DR
48 ;the following updates MFI information **** NOT DONE IN THE VA ****
49 ;Q:'$D(^AUTTSITE(1,0))
50 ;Q:$P(^AUTTSITE(1,0),U,16)'="V"
51 ;Q:DUZ=.5
52 ;I $P(^AUPNVSIT(AUPNVSIT,0),U,15)'="A",$P(^(0),U,15)'="D" S DR=".15///M",DA=AUPNVSIT,DIE="^AUPNVSIT(" D ^DIE
53 ;K DIE,DA,DR,DIU,DIV
54 Q
55 ;*******CANNOT BE CALLED FROM DIE**********CALLS DIE
56DEL ;EP;*** EXTERNAL ENTRY POINT *** SET DELETE FLAG
57 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.
58 ; The following exclusive NEW excepted from SAC by the Director, DSD. Request dated 12.14.92. No suspense was mandated.
59 ;N (DT,DUZ,AUPNVSIT,U)
60 ;I $P(^AUPNVSIT(AUPNVSIT,0),U,9) S AUPNVSIT=-1 Q
61 ;S DIK="^AUPNVSIT(",DA=AUPNVSIT,X=2 D DD^DIK,1^DIK1
62 ;S DA=AUPNVSIT,DR=".11///1",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR
63 ;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
64 ;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
65 Q
Note: See TracBrowser for help on using the repository browser.