[613] | 1 | YSPPJ ;ALB/ASF-JUMP BETWEEN INQUIRY SCREENS ;4/14/93 17:31 ;07/07/93 14:10
|
---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
---|
| 3 | ;
|
---|
| 4 | FIND ; Called from MENU option YSPATPROF
|
---|
| 5 | F D ONE Q:YSDFN<1
|
---|
| 6 | K YSDFN D QUIT
|
---|
| 7 | Q
|
---|
| 8 | ;
|
---|
| 9 | ONE ;
|
---|
| 10 | W @IOF D ^YSLRP Q:YSDFN<1 S (DA,DFN)=YSDFN D DEM^VADPT,PID^VADPT,HOME^%ZIS
|
---|
| 11 | D:$D(XRTL) T0^%ZOSV ; START Response check measure
|
---|
| 12 | S X="IORVON;IORVOFF" D ENDR^%ZISS
|
---|
| 13 | F I=0,.11,.111,.13,.21,.211,.24,.15,.3,.311,.31,.321,.32,.33,.331,.34,.362,.36,.52,1010.15 S A(I)="" S:$D(^DPT(DA,I))#10 A(I)=^(I)
|
---|
| 14 | MENU ;
|
---|
| 15 | W @IOF,"NAME: ",VADM(1),?40,"SSN: ",YSSSN,?60,"DOB: ",$P(VADM(3),U,2) S PROFILE=1,HOLDA=A(0)
|
---|
| 16 | W !!?5 W IORVON," P A T I E N T P R O F I L E ",IORVOFF W !
|
---|
| 17 | F YSI=1:1 S G=$T(PROG+YSI) Q:G="" S G3=$P(G,";",4),G4=$P(G,";",5),G5=$P(G,";",6) W !,$J(YSI,2),".",?5,G3 I G4]"" X G4 I '$T W ?45,IORVON," no ",G5,?78,IORVOFF
|
---|
| 18 | S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; STOP Response check measure
|
---|
| 19 | M ;
|
---|
| 20 | K DIR
|
---|
| 21 | S A8=0 W !!
|
---|
| 22 | S DIR(0)="FO^1:24",DIR("A")="Enter section number(s) or 'P' to print or 'Q' for quick look ",DIR("?")="Enter a numeric string ex. 2,4,7-9"
|
---|
| 23 | S DIR("?",1)="'P' or 'p' for print 'Q' or 'q' for quick look" D ^DIR K DIR S A1=Y
|
---|
| 24 | I $D(DIRUT) D QUIT S YSDFN=-1 Q
|
---|
| 25 | I $E(A1,1)="-" W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
|
---|
| 26 | I A1["-"!(A1[11) D LIST S A1=YSEXT
|
---|
| 27 | S A1=$TR(A1,"pq","PQ")
|
---|
| 28 | G MENU2:A1,MENU1:"P"[A1 I "Q"'[A1 W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
|
---|
| 29 | D EN^YSDGDEM Q
|
---|
| 30 | LIST ;
|
---|
| 31 | K YSRY S CT=0,ANS=A1
|
---|
| 32 | ;
|
---|
| 33 | ; Did user enter a range, or selection including 11 + more'n 11?
|
---|
| 34 | I $G(ANS)[11&(+ANS'=11) D
|
---|
| 35 | . S ANS="1-10"
|
---|
| 36 | . W !!,"Including all sections...",!!
|
---|
| 37 | ;
|
---|
| 38 | F YSI=1:1:$L(ANS,",") S X=$P(ANS,",",YSI) I +X>0 S CT=CT+1,YSRY(CT)=$P(ANS,",",YSI)
|
---|
| 39 | ;
|
---|
| 40 | S YSEXT="",OK=1
|
---|
| 41 | S YSLN=0 F S YSLN=$O(YSRY(YSLN)) QUIT:YSLN'>0 D QUIT:OK=0
|
---|
| 42 | . S SUB=$G(YSRY(YSLN)) QUIT:SUB']"" ;->
|
---|
| 43 | . I +SUB=SUB S YSEXT=YSEXT_+SUB_"," QUIT
|
---|
| 44 | . I SUB?1.2N1"-"1.2N D S YSRY(YSLN)=YSEXT
|
---|
| 45 | . . S X=+SUB,Y=+$P(SUB,"-",2)
|
---|
| 46 | . . I X>Y!(Y>10) S OK=0 QUIT
|
---|
| 47 | . . F YSAI=X:1:Y S YSEXT=YSEXT_YSAI_","
|
---|
| 48 | I OK=0 W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
|
---|
| 49 | I $E(YSEXT,$L(YSEXT))="," S YSEXT=$E(YSEXT,1,$L(YSEXT)-1)
|
---|
| 50 | Q
|
---|
| 51 | ;
|
---|
| 52 | MENU1 ;
|
---|
| 53 | S DIR(0)="LO^1:11" D ^DIR K DIR I $D(DIRUT)!('Y) Q
|
---|
| 54 | S A8=Y
|
---|
| 55 | I A8[11 S A8="1,2,3,4,5,6,7,8,9,10" W !!,"Including all sections...",!!
|
---|
| 56 | MENU2 ;
|
---|
| 57 | I 'A8 S A8=$S(A1=11:"1,2,3,4,5,6,7,8,9,10",A1?1N.1",".E:A1,1:"") I 'A8 D QUIT Q
|
---|
| 58 | I A8<1!(A8>10) W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
|
---|
| 59 | AD ;
|
---|
| 60 | I IOST?1"C-".E,A8?1N.N I $L(A1)>1!(A1=10) F I=A8+1:1:10 S A8=A8_","_I
|
---|
| 61 | S YSA8=A8 K IOP S %ZIS="Q" D ^%ZIS I POP D QUIT S YSDFN=-1 Q
|
---|
| 62 | I $D(IO("Q")),IOST?1"C-".E W " - You can't queue to a CRT!",$C(7) K IO("Q") G AD
|
---|
| 63 | I $D(IO("Q")) S ZTRTN="ENP^YSPPJ",(ZTSAVE("YS*"),ZTSAVE("DFN"),ZTSAVE("A("),ZTSAVE("DA"))="",ZTSAVE("PROFILE")="",ZTSAVE("HOLDA")="",ZTDESC="YS PROFILE PRT" D ^%ZTLOAD,HOME^%ZIS,QUIT Q
|
---|
| 64 | ;
|
---|
| 65 | ENP ; Called by routine YSCEN39
|
---|
| 66 | S YST=$S(IOST?1"C-".E:0,1:1),YSLFT=0 U IO
|
---|
| 67 | F YSI=1:1 S A1=$P(YSA8,",",YSI) Q:A1=""!(YSLFT) I A1>0,A1<11 S A2=$P($T(PROG+A1),";",3) D @A2
|
---|
| 68 | G:$D(YSCENN) QUIT
|
---|
| 69 | ;K YSA8 I YSLFT,A1 K A1,A8 D MENU ;Commented 7/7/93 LJA
|
---|
| 70 | FIN ;
|
---|
| 71 | D ^%ZISC,HOME^%ZIS S A(0)=HOLDA I $G(ZTSK) S ZTREQ="@"
|
---|
| 72 | QUIT ;
|
---|
| 73 | K %,%ZIS,A,ANS,A1,A2,A6,A7,A8,C,CT,D,DA,DIC,YSDT(0),YSDT(1),G,G3,G4,G5,I0,IO("Q"),I1,I2,I3,L,L1,L2,L3,L4,N3,R1,R2,S,SUB,S2,S5,X,X1,X2
|
---|
| 74 | K Y,YSA8,YSADMDT,YSAGE,YSAI,YSCON,YSCOV,YSDISP,YSDOB,YSEXT,YSFA,YSFTR,YSFHDR,YSI,YSIA,YSLFT,YSLN,YSNM,YSPNH,YSRY,YSSEX,YSSKIP,YSSSN,YST,YSTB,YSTRNDT,ZTSK
|
---|
| 75 | D KILL^%ZISS,KVAR^VADPT
|
---|
| 76 | K AI,DX1,DX2,DX3,G11,J,K,L10,L11,L5,L6,L8,L9,N1,RDT,ST,ST1,STDT,YSDXNN,YSCLI,YSOC,PROFILE,HOLDA Q:$D(YSCENN)
|
---|
| 77 | Q
|
---|
| 78 | PROG ;
|
---|
| 79 | 1 ;;^YSPP;Identifying data
|
---|
| 80 | 2 ;;^YSPP1;Next of kin, employment, claim number
|
---|
| 81 | 3 ;;^YSPP1A;Disability, financial
|
---|
| 82 | 4 ;;^YSPP2;Military
|
---|
| 83 | 5 ;;^YSPP4;Inpatient data/Application for care;I $D(^DGPM("ATID1",YSDFN));inpatient admissions
|
---|
| 84 | 6 ;;^YSPP5;Outpatient data;I $D(^DPT(YSDFN,"DE"))>0!($D(^DPT(YSDFN,"S"))>0);appointment data
|
---|
| 85 | 7 ;;^YSPP6;DSM/ICD9 Diagnosis list;I $D(^YSD(627.8,"AF",YSDFN))>0;diagnosis
|
---|
| 86 | 8 ;;^YSPP7;Last physical exam;IF $D(^MR(YSDFN,"PE"))>0;physical
|
---|
| 87 | 9 ;;^YSPP8;Problem list, MH tests & interviews;I $D(^YTD(601.2,"B",YSDFN))>0;tests/interviews
|
---|
| 88 | 10 ;;^YSPP9;Short problem list;IF $D(^YS(615,YSDFN,"PL"))>0;problem list
|
---|
| 89 | 11 ;;;All Sections;;
|
---|