source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN26.m@ 623

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1YSCEN26 ;ALB/ASF-MH CENSUS PATIENT LIST FOR STAFF ;4/3/90 10:20 ;08/12/93 16:51
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3WHO ; Called by routine YSCEN3
4 R !,"Sort by (T)herapist, (P)hysician or (R)esident: ",X2:DTIME S YSTOUT='$T,YSUOUT=X2["^" Q:YSTOUT!YSUOUT S X2=$TR($E(X2_1),"trp","TRP") I "TPR"'[X2 W !,"Select above for listing by either Physician, Resident or primary Therapist",! G WHO
5 S YSCR="AC",YSOPT9L="PRIMARY THERAPIST" S:"P"[X2 YSCR="ACP",YSOPT9L="PHYSICIAN" S:"R"[X2 YSCR="ACR",YSOPT9L="RESIDENT"
6 I YSOPT9L'="PRIMARY THERAPIST" S DIC("S")="I $S(+$G(^(""I""))=0:1,$G(^(""I""))'<DT:1,1:0)",D="AK.PROVIDER"
7 S:'$D(D)#2 D="B" S DIC="^VA(200,",DIC("A")="Select "_YSOPT9L_": ",DIC(0)="AEQ" D MIX^DIC1 K D,DIC
8 D:X="" MSG1 G:X="" WHO Q:Y<1 G:'$D(^YSG("INP",YSCR,+Y)) EMPT S YSWHO=+Y,POP="",(Q3,P1,W1)=0,T6="S",%ZIS="Q" K IOP I $D(YSFLG) S:YSFLG IOP=0
9 D ^%ZIS S YSUOUT=$G(POP)
10 Q
11 ;
12S1 ; Called by routines YSCEN2, YSCEN23, YSCEN35
13 ;
14 I $G(YSCOPY)=1 S YSOPT9L=$S('$D(YSOPT9L):"",1:YSOPT9L_" list for: ")
15 K ^UTILITY("YSCEN",$J),^UTILITY($J)
16 S DA=0 F S DA=$O(^YSG("INP",YSCR,YSWHO,DA)) Q:'DA S G=^YSG("INP",DA,0),G7=^(7),YSDFN=+$P(G,U,2),W1=+$P(G7,U),T6=+$P(G7,U,4),^UTILITY("YSCEN",$J,W1,T6,$P(^DPT(YSDFN,0),U),YSDFN)=DA
17 S YSRD=0 F S YSRD=$O(^YSG("CEN","AFS",YSRD)) Q:'YSRD S W1=$O(^(YSRD,0)),W2=$P(^DIC(42,W1,0),U) I $D(^UTILITY("YSCEN",$J,W1)) D SS2
18 I $G(YSCOPY)>0&($G(YSCOP)>0),YSCOPY<YSCOP QUIT
19 G END
20SS2 ;
21 S YSOR=0 F S YSOR=$O(^YSG("SUB","AOR",W1,YSOR)) Q:'YSOR S T6=$O(^(YSOR,0)) D SS3,SS4
22 Q
23SS3 ;
24 S N1="",YSTM=0 F S N1=$O(^UTILITY("YSCEN",$J,W1,T6,N1)) Q:N1="" S YSDFN=$O(^(N1,0)),DA=^(YSDFN) I $D(^YSG("INP","AWC",W1,T6,DA)) S YSTM=YSTM+1,^UTILITY($J,N1,YSDFN)=DA
25 Q
26SS4 ;
27 Q:'$D(^UTILITY($J)) D:$D(YSOPT2) @YSOPT2 D:'$D(YSOPT2) L3^YSCEN2,WAIT^YSCEN1 K ^UTILITY($J)
28 Q
29END ;
30 K ^UTILITY($J),^UTILITY("YSCEN") D KILL^%ZTLOAD
31 K DIE,DIC,DR,DIK,I,I7,N,P1,X1,X2,YSCR,YSOPT9L,YSWHO,YSOPT1,YSOPT1L,YSOPT2,W1,YSNM,YSSSN,YSAGE,X,G2,G,ZTSK Q
32EMPT ;
33 W !,"No patients are listed for this staff member as ",YSOPT9L,!,$C(7) S Y=-1 G WHO
34MSG1 ;
35 W !!,"Since STAFF was selected as a sort option a valid ",YSOPT9L," is required.",! H 4 Q
Note: See TracBrowser for help on using the repository browser.