source: FOIAVistA/tag/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN1.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1YSCEN1 ;ALB/ASF-MH CENSUS ENTRY/EDIT; 4/16/92 09:52
2 ;;5.01;MENTAL HEALTH;**52**;Dec 30, 1994
3 ;
41 ; Called from MENU option YSCENUNITUP
5 ;
6 S DIC("A")="Select Mental Health Ward: ",DIC="^YSG(""CEN"",",DIC(0)="AEQLM",DLAYGO=618 D ^DIC K DIC I Y<1 G END
7 S DA=+Y,DIE="^YSG(""CEN"",",DR="[YSCEN UNIT DEF]"
8 L +^YSG("CEN",DA):5 I '$T W !,"Record being updated" Q
9 D ^DIE L -^YSG("CEN",DA) S YSTOUT=$D(DTOUT) I YSTOUT G END
10 G 1
11 ;
122 ; Called from MENU option YSCENSUBUP
13 ;
14 S DIC="^YSG(""SUB"",",DIC(0)="AEQL",DLAYGO=618 D ^DIC I Y<1 G END
15 S DA=+Y,DIE=DIC,DR="0:99"
16 L +^YSG("SUB",DA):5 I '$T W !,"Record being updated" Q
17 D ^DIE L -^YSG("SUB",DA) S YSTOUT=$D(DTOUT) I YSTOUT G END
18 G 2
193 ;
20 K DIC,DLAYGO,DR,DIE S DIC("S")="I $P(^YSG(""INP"",+$G(Y),7),U)=W1",DIC="^YSG(""INP"",",DIC(0)="EQZM",YSFLG=0
21 R !,"Select Patient: ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" G:YSTOUT!YSUOUT END Q:X="" I X?1"?".E W !?5,"Select a Patient within the previously selected Inpatient Ward",! S DZ="??",D="CP" D DQ^DICQ G 3
22 K DIC("S") D 1^YSLRP I $G(YSTOUT) G END
23 G:YSDFN<1 3 S (YDA,DA)=$O(^YSG("INP","CP",YSDFN,0)) I YDA,+^YSG("INP",YDA,7)'=W1 S YDA=-1
24 I YDA<1 W !,$P(^DPT(YSDFN,0),U)," not currently a patient on this ward",$C(7) G 3
254 ;
26 S DIE="^YSG(""INP"",",DR="2;3"
27 L +^YSG("INP",DA):5 I '$T W !,"Record being updated" Q
28 D ^DIE L -^YSG("INP",DA) S YSTOUT=$D(DTOUT) I YSTOUT G END
29 G:$D(Y) 3:'YSFLG,Q S W5=$P(^YSG("INP",YDA,0),U,4)
30 S DIC=200,DIC(0)="AEQ",DIC("A")=$S(W5<1:"Staff",$P(^YSG("SUB",W5,0),U,10)]"":$P(^(0),U,10),1:"Staff")_": "
31 I $P(^YSG("INP",DA,0),U,5)?1N.N S DIC("A")=DIC("A")_$P(^VA(200,$P(^YSG("INP",DA,0),U,5),0),U)_" // "
32 D ^DIC K DIC S YSTOUT=$D(DTOUT) I YSTOUT G END
33 G:X="^" 3:'YSFLG,Q I +Y?1N.N,Y>1 S DR="4////"_+Y
34 L +^YSG("INP",DA):5 I '$T W !,"Record being updated" Q
35 D ^DIE L -^YSG("INP",DA)
36 S DR="5:6;7;8;9;12:17"
37 L +^YSG("INP",DA):5 I '$T W !,"Record being updated" Q
38 D ^DIE L -^YSG("INP",DA) S YSTOUT=$D(DTOUT) I YSTOUT G END
39 G:$D(Y) 3:'YSFLG,Q
40 I $D(^YSG("INP",DA,5,1)) D COM^YSCEN22 W !
41COMM ;
42 R !,"Do you wish to enter an Inpatient comment? N// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^"
43 Q:YSUOUT S YSR1="X",YSR2="N",YSR3="YN" D ^YSCEN14 G COMM:X="?" G DXE:X="N" I X=-1 G Q:YSFLG,3:'YSFLG
44 ;
45CM ; Called from routine YSCEN51
46 ;
47 S DIC="^YSG(""INP"",YDA,5,",DIC(0)="L",DLAYGO=618,X="""NOW""",DA(1)=YDA,$P(^YSG("INP",YDA,5,0),U,2)="618.418D" D ^DIC S DA=+Y,DIE="^YSG(""INP"",YDA,5,",DR="1///^S X=""`""_DUZ;2"
48 L +^YSG("INP",YDA):5 I '$T W !,"Record being updated" Q
49 D ^DIE L -^YSG("INP",YDA)
50 S YSTOUT=$D(DTOUT) I YSTOUT G END
51DXE ;
52 R !,"Do you wish to enter diagnoses? N// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" Q:YSTOUT
53 S YSR1="X",YSR2="N",YSR3="YN" D ^YSCEN14 G DXE:X="?",PLE:X="N" G:X=-1&('YSFLG) 3 Q:X=-1&(YSFLG) D DXE1 G PLE
54DXE1 ;
55 S YSDFN1=YSDFN
56 N C1,C2,DA,I,J,P1,W1,W2,YSDFN
57 K YSQT S YSDFN=YSDFN1,YSDUZ=$P(^VA(200,DUZ,0),U) D ENPT^YSUTL
58 W @IOF,!?7,"Diagnosis Entry",?$X+5,YSNM,?$X+5,YSSSN,! D OLD^YSDX3 I YSTOUT G END
59 D ^YSDX3A I YSTOUT G END
60 D AXIS4^YSDX3B I YSTOUT G END
61 D AXIS5^YSDX3B
62 Q
63PLE ;
64 R !,"Do you wish to enter Problem List? N// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" Q:YSTOUT
65 S YSR1="X",YSR2="N",YSR3="YN" D ^YSCEN14 G PLE:X="?" G:X=-1&('YSFLG) 3 Q:X=-1&(YSFLG) D:X'="N" PLE1 G 3
66PLE1 ;
67 S YSDFN1=YSDFN N DA,I,P1,S2,YSDFN,YSNM S YSDFN=YSDFN1 D ENPT^YSUTL W @IOF,!?7,"Problem List Entry",?$X+5,YSNM,?$X+5,YSSSN,! D H^YSPROB,ENA1^YSPROB:$D(^YS(615,YSDFN,"PL")),F1^YSPROB:$D(YSDFN) Q
68 ;
69ED ; Called from MENU option YSCENED
70 ;
71 K DIC D UN^YSCEN2 G:Y<1 END S (P1,Q3)=0,YSFLG=0 D FS0^YSCEN,UNLST^YSCEN13 G:$D(YSTOUT) END D 3 G END
72 ;
73EDG ; Called from MENU option YSCENGED
74 ;
75 K YSOPT1,YSOPT2,YSQT S IOP=0,YSFLG=1 D A1^YSCEN3 Q:Y<1 S P1=0,YSOPT2="GED^YSCEN1" D:T6'="A" L2^YSCEN2 D:T6="A" L1^YSCEN2
76 G END
77GED ;
78 S:'$D(Q3) Q3=0 S YSNM=""
79 F S YSNM=$O(^UTILITY($J,YSNM)) Q:YSNM=""!(Q3) S YSDFN=$O(^UTILITY($J,YSNM,0)),YSFLG=1,(DA,YDA)=$O(^YSG("INP","CP",YSDFN,0)) I YDA D ENPT^YSUTL W @IOF,!?7,YSNM,?$X+5,YSSSN,?$X+5,"TEAM: ",$P(^YSG("SUB",T6,0),U),! D 4,WAIT Q:Q3
80Q ;
81 Q
82NW ;
83 D ENDTM^YSUTL S Y=YSDTM D ENDD^YSUTL Q
84 ;
85END ; Called from routine YSCEN13
86 ;
87 K C,C1,C2,D0,DA,DIYS,DIC,DIE,DR,DQ,E2,E3,I,P1,J,Q3,R,W2,W4,W5,W1,X,Y,YSDFN,YSDFN1,YSQT,YSAGE,YSBID,YSDOB,YSHDR,YSNM,YSOPT2,YSSEX,YSSSN,VA,VADM,X1,X1,YSD,YSNM,YDA,YSHR Q
88WAIT ; Called from routine YSCEN, YSCEN2, YSCEN21, YSCEN22, YSCEN23, YSCEN24
89 ; YSCEN26, YSCEN3, YSCEN32, YSCEN33, YSCEN34, YSCEN35, YSCEN39
90 ; YSCEN4, YSCEN5, YSCEN52, YSCEN53, YSCEN55, YSCEN6, YSCEN61, YSCEN7
91 ; YSCEN8, YSCEN81
92 I $D(Q3) Q:Q3
93 ;I $D(YSO) Q:YSO=10
94 I $D(YSOPT1),YSOPT1="PROB^YSCEN3",$D(YSLFT) S Q3=+$G(YSLFT) Q
95 I IOST?1"C-".E F ZZ=1:1:(IOSL-$Y-4) W !
96 Q:IOST["P-"!(IOST["PK-")
97 S DIR(0)="E" D ^DIR K DIR S Q3=$D(DIRUT) Q
98 ;
99COPIES ; Called from routine YSCEN23, YSCEN35
100 ;
101 S YSCOP=1 I $D(IOST),IOST'?1"C".E R !,"How many copies? (1-4) 1// ",YSCOP:DTIME S YSTOUT='$T,YSUOUT=YSCOP["^" Q:YSTOUT
102 S YSR1="YSCOP",YSR2=1,YSR3=4 D ^YSCEN14 G COPIES:YSCOP="?" Q
103 Q
Note: See TracBrowser for help on using the repository browser.