source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN24.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1YSCEN24 ;ALB/ASF-CUSTOM PATIENT LIST ;4/3/90 10:19 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 ; Called from the top by MENU option YSCENCL
5 ;
6 W @IOF,!!?IOM-$L("P A T I E N T D A T A F I E L D S E A R C H")\2,"P A T I E N T D A T A F I E L D S E A R C H",!!
7RD ;
8 R !,"Search for (M)issing data or (D)isplay data? M// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" G:YSTOUT!YSUOUT END S X=$TR($E(X_"M"),"md","MD") I X="M" G MIS
9 I X="D" G HERE
10 W !!,$C(7),"enter 'M' to list patients with missing data",!,"enter 'D' to list a unique data field for each patient by team",! G RD
111 ;
12 S DIC("A")="Select patient data field on which to search: ",DIC="^DD(618.4,",DIC(0)="AEQMNZ" D ^DIC K DIC Q:Y<1 S YSENT=+Y,YSGL1=$P(^DD(618.4,YSENT,0),U,4),YSG=+YSGL1,YSPE=$P(YSGL1,";",2)
13 S L=$P(^DD(618.4,YSENT,0),U),YSTP=$P(^(0),U,2),YSPOIN=$P(^(0),U,3)
14 Q
15 ;
16HERE ;
17 D 1 G:Y<1 END S YSOPT1L=" "_L_" listing",YSOPT1="EN^YSCEN24",P=1,(Q3,P1)=0 D UN^YSCEN2 G:Y<1 END K IOP S %ZIS="Q" D ^%ZIS G:POP END
18 I $D(IO("Q")) K IO("Q") S ZTRTN="ENHR^YSCEN24",ZTDESC="YS IP HERE" F ZZ="L","YSTP","YSPOIN","YSENT","YSGL1","YSG","YSPE","W1","P1","W2","Q3","YSOPT1","YSOPT1L" S ZTSAVE(ZZ)=""
19 I D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
20ENHR ;
21 U IO D FS0^YSCEN S YSAOR=0 F S YSAOR=$O(^YSG("SUB","AOR",W1,YSAOR)) Q:'YSAOR S T6=$O(^(YSAOR,0)) Q:'T6!Q3 K ^UTILITY($J) W @IOF D L2^YSCEN2,L3^YSCEN2,WAIT^YSCEN1
22 G END0^YSCEN2
23EN ;
24 G EN1:+YSTP,EN22:YSTP?1"C".E S T=$P($G(^YSG("INP",DA,YSG)),U,YSPE) G PT:T="" I YSTP?.E1"P".E S T=@("^"_YSPOIN_"T,0)"),T=$P(T,U)
25 I YSTP?.E1"D".E S Y=T D DD^%DT S T=Y
26 I YSTP?.E1"S".E F ZZ=1:1 S K=$P(YSPOIN,";",ZZ) Q:K="" S K1=$P(K,":"),K2=$P(K,":",2) I T=K1 S T=K2 Q
27PT ;
28 W !?3,L,": ",$S(T]"":T,1:" **missing**") Q
29EN1 ;
30 G COM^YSCEN22:YSENT=18 S Z=0 F S Z=$O(^YSG("INP",DA,6,Z)) Q:'Z S Z1=^(Z,0),Z(1)=$P(^YSG("SUB",+Z1,0),U),Y=$P(Z1,U,2) D DD^%DT,EN11
31 W ! Q
32EN11 ;
33 S YSB=$P(Z1,U,3) S:YSB YSB=$P(^VA(200,YSB,0),U) W !?3,"Past team: ",Z(1)," on ",Y W:YSB?1A.E " by ",YSB
34 Q
35EN22 ;
36 K X S D1=YSDFN,X5=$P(^DD(618.4,YSENT,0),U,5,99) X X5 W !?3,L," : ",$S('$D(X):"Missing",$D(X)&(X]""):X,1:"missing") K X5 Q
37 ;
38MIS ;
39 K YSOPT1,YSOPT2 D 1 G:Y<1 END S (P,P1,Q3)=0 D UN^YSCEN2 G:Y<1 END K IOP S %ZIS="Q" D ^%ZIS G:POP END
40 I $D(IO("Q")) K IO("Q") S ZTRTN="ENMSQ^YSCEN24",ZTDESC="YS IP MISS" F ZZ="L","YSTP","YSPOIN","YSENT","YSGL1","YSG","YSPE","W1","P1","W2","Q3" S ZTSAVE(ZZ)=""
41 I D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
42ENMSQ ;
43 W @IOF D FS0^YSCEN K ^UTILITY($J) S YSAOR=0 F S YSAOR=$O(^YSG("SUB","AOR",W1,YSAOR)) Q:'YSAOR S T6=$O(^(YSAOR,0)) Q:'T6 D L2^YSCEN2
44MIS1 ;
45 D MLB S A5="" F S A5=$O(^UTILITY($J,A5)) Q:A5=""!Q3 D MIS2
46 G END0^YSCEN2
47MIS2 ;
48 S YSDFN=0 F S YSDFN=$O(^UTILITY($J,A5,YSDFN)) Q:'YSDFN!Q3 S DA=^UTILITY($J,A5,YSDFN) D MIS3 D:$Y+4>IOSL WAIT^YSCEN1,MLB
49 Q
50MIS3 ;
51 S G=$D(^YSG("INP",DA,YSG)) I 'G D NM Q
52 I YSTP?1"C".E S G=$P(^DD(618.4,YSENT,0),U,5,99),D1=YSDFN K X X G S:'$D(X) X="" D NM:X'?1ANP.E Q
53 I '+YSTP S T=$P(^YSG("INP",DA,YSG),U,YSPE) I $S($D(T):T="",1:1) D NM Q
54 I +YSTP S T=$D(^YSG("INP",DA,YSG)) I T<10 D NM Q
55 Q
56NM ;
57 W !,A5,?33 S T=^YSG("INP",DA,0),T(1)=$P(T,U,4) W:T(1) $P(^YSG("SUB",T(1),0),U) S T=$P(T,U,3) W ?60,$E(T,4,5)_"/"_$E(T,6,7)_"/"_$E(T,2,3)
58 Q
59MLB ;
60 Q:Q3 W @IOF,W2 D TIME^YSCEN2 W !,"The following patients have ",L," missing:",!?3,"name",?33,"team",?60,"ward entry date",! Q
61END ;
62 G END^YSCEN2
Note: See TracBrowser for help on using the repository browser.