| 1 | YSPHY ;SLC/RWF,SLC/DKG-PHYSICAL EXAM / MENTAL HEALTH ;11/19/90 16:43 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**12,14**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ;If YSEDIT=1, new exam. If YSEDIT=0, editing previous exam.
|
|---|
| 5 | ;
|
|---|
| 6 | ; Called from the top by MENU option YSPHYEXAM
|
|---|
| 7 | ;
|
|---|
| 8 | 1 ;
|
|---|
| 9 | D ^YSLRP G:YSDFN<1 END^YSPHY1 S YSPE="PE",P=",",YSTIME=0
|
|---|
| 10 | S YSYDT=DT W !!?3,"Physical Exam for ",YSNM," ",YSSEX," Age ",YSAGE,!!
|
|---|
| 11 | D DTS Q:YSUOUT I YSTOUT G END^YSPHY1
|
|---|
| 12 | EL ;
|
|---|
| 13 | W !!?3 W:YSNEW=1 "(E)nter" W:YSNEW=0 "(E)dit, (P)rint" R " OR (Q)uit: E// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" S:A="" A="E" S A=$TR($E(A),"epq","EPQ") I YSTOUT G END^YSPHY1
|
|---|
| 14 | Q:YSUOUT!(A="Q")
|
|---|
| 15 | G IN:"E"[A,LIST:"P"[A W:A'["?" $C(7)," ?" D:A["?" HLP1^YSPHY1 G EL
|
|---|
| 16 | IN ;
|
|---|
| 17 | D CHK1^YSPHY1 I $D(YSUOUT),YSUOUT=1 D END^YSPHY1 Q
|
|---|
| 18 | S YSIDT=9999999-YSYDT
|
|---|
| 19 | EN ;
|
|---|
| 20 | L +^MR(YSDFN)
|
|---|
| 21 | S DIE="^MR(YSDFN,YSPE,",DA(1)=YSDFN,DA=YSIDT S:'$D(^MR(YSDFN,YSPE,0)) ^(0)="^90.01D^^0",YSEDIT=1
|
|---|
| 22 | I YSNEW=1 S YSNE=$P(^MR(YSDFN,YSPE,0),U,4)+1,^MR(YSDFN,YSPE,0)=$P(^MR(YSDFN,YSPE,0),U,1,2)_U_YSIDT_U_YSNE K YSNE
|
|---|
| 23 | S:'$D(^MR(YSDFN,YSPE,YSIDT,0)) ^(0)=YSYDT,^MR(YSDFN,YSPE,"B",YSYDT,YSIDT)="",^MR("B",YSDFN,YSDFN)="",^MR(YSDFN,0)=YSDFN
|
|---|
| 24 | S YSHDF=$P(^MR(0),U,3) S:YSDFN>YSHDF YSHDF=YSDFN S:YSEDIT=1 YSNM=$P(^MR(0),U,4)+1 S:YSEDIT=0 YSNM=$P(^MR(0),U,4) S ^MR(0)=$P(^MR(0),U,1,2)_U_YSHDF_U_YSNM K YSHDF,YSNM L -^MR(YSDFN)
|
|---|
| 25 | EN1 ;
|
|---|
| 26 | R !!?3,"Enter 'M' for METRIC or 'E' for ENGLISH measurements",!?10," or 'B' for BOTH: E// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" I YSUOUT D ENCLN^YSPHY1 Q
|
|---|
| 27 | I YSTOUT G END^YSPHY1
|
|---|
| 28 | I "Ee"[$E(X) S DR="29//"_$P(^VA(200,DUZ,0),U)_";.02:.07;.9" G EN2
|
|---|
| 29 | I "Mm"[$E(X) S DR="29//"_$P(^VA(200,DUZ,0),U)_";32:34;.05:.07;.9" G EN2
|
|---|
| 30 | I "Bb"[$E(X) S DR="29//"_$P(^VA(200,DUZ,0),U)_";.02;32;.03;33;.04;34;.05:.07;.9" G EN2
|
|---|
| 31 | W:X'["?" " ?",$C(7) W !?4,"Specify measurement system for height, weight, and temperature." G EN1
|
|---|
| 32 | EN2 ;
|
|---|
| 33 | W ! K ^DISV(DUZ,"^VA(200,"),^DISV(DUZ,"^VA(200,") L +^MR(YSDFN) D ^DIE L -^MR(YSDFN) S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]"" I YSTOUT!YSUOUT D ENCLN^YSPHY1 G END^YSPHY1
|
|---|
| 34 | I '$D(^MR(YSDFN,YSPE,YSIDT,.9)) L +^MR(YSDFN) S ^MR(YSDFN,YSPE,YSIDT,.9)="1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^"
|
|---|
| 35 | L -^MR(YSDFN)
|
|---|
| 36 | EN21 ;
|
|---|
| 37 | S %=0 F Q:$G(%) W !!,"Is the ENTIRE physical exam NORMAL" S %=2 D YN^DICN I '% D
|
|---|
| 38 | .S XQH="YS-PHY-EXAM-NORM" D EN^XQH
|
|---|
| 39 | S YSTOUT=$D(DTOUT) I YSTOUT G END^YSPHY1
|
|---|
| 40 | I %<0 S YSUOUT=%Y="^" D:YSUOUT&(YSEDIT=1) MSG3^YSPHY1 D:YSUOUT&(YSEDIT=0) MSG6^YSPHY1 G END^YSPHY1
|
|---|
| 41 | I %=1 G IMP
|
|---|
| 42 | S YSDIZ=DIE D YSDIZ^YSPHY1 I X["^" D:YSEDIT=1 MSG3^YSPHY1 D:YSEDIT=0 MSG6^YSPHY1 G END^YSPHY1
|
|---|
| 43 | IMP ;
|
|---|
| 44 | S:'$D(Y) Y=1 ;Biloxi fix relative to Screen Man
|
|---|
| 45 | S ^MR(YSDFN,YSPE,YSIDT,20,0)="",DIC="^MR(YSDFN,YSPE,YSIDT,20,",DWPK=1 W !!," Initial Impression: " D EN^DIWE
|
|---|
| 46 | S ^MR(YSDFN,YSPE,YSIDT,19,0)="",DIC="^MR(YSDFN,YSPE,YSIDT,19,"
|
|---|
| 47 | IMP1 ;
|
|---|
| 48 | W !,"Do you need to enter comments" S %=2 D YN^DICN
|
|---|
| 49 | S YSTOUT=$D(DTOUT),YSUOUT=%<0 I YSTOUT!YSUOUT G END^YSPHY1
|
|---|
| 50 | I '% W $C(7)," ?" D IMP1
|
|---|
| 51 | I %=2 G END^YSPHY1
|
|---|
| 52 | W !!," Comments: " S DWPK=1 D EN^DIWE G END^YSPHY1
|
|---|
| 53 | LIST ;
|
|---|
| 54 | G:YSNP END^YSPHY1 S YSIDT=9999999-YSYDT,DA=YSIDT I '$D(^MR(YSDFN,YSPE,DA,0)) S Y=YSYDT D ENDD^YSUTL W $C(7),!!!?3,"No Physical Exam on file for ",Y H 2 D DTS G EL
|
|---|
| 55 | S %ZIS="Q" D ^%ZIS G:POP END^YSPHY1 I $D(IO("Q")) S ZTRTN="^YSPHYR",(ZTSAVE("DA"),ZTSAVE("YS*"))="",ZTDESC="YS PHY EX PRINT" D ^%ZTLOAD G END^YSPHY1
|
|---|
| 56 | G ^YSPHYR
|
|---|
| 57 | DTS ;
|
|---|
| 58 | S (YSNP,YSTOUT,YSUOUT,YSNEW,YSEDIT)=0
|
|---|
| 59 | I '$O(^MR(YSDFN,YSPE,0)) D QUIT
|
|---|
| 60 | . S (YSNP,YSNEW)=1
|
|---|
| 61 | . W $C(7),!!?3,"No Physical Exams on file",!!
|
|---|
| 62 | S (YSK,YSIDT,YSLDT)=0 W !!?10,"PREVIOUS PHYSICAL EXAMS",!
|
|---|
| 63 | YSIDT ;
|
|---|
| 64 | S YSIDT=$O(^MR(YSDFN,YSPE,YSIDT))
|
|---|
| 65 | G:'YSIDT SEL
|
|---|
| 66 | S YSK=YSK+1,YSHD=9999999-YSIDT,(A(+YSK),Y,YSY,YSA(+YSK))=YSHD,YSLDT=YSIDT
|
|---|
| 67 | D ENDD^YSUTL S YSY=Y
|
|---|
| 68 | W !?8,$J(YSK,3)," ",YSY
|
|---|
| 69 | G YSIDT
|
|---|
| 70 | SEL ;
|
|---|
| 71 | I YSK=1 W !?10,YSY," OK" S %=1 D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=%Y="^" Q:YSTOUT!YSUOUT I '% D HLP2^YSPHY1 G SEL
|
|---|
| 72 | I YSK=1,%=2 D CHK2^YSPHY1 QUIT
|
|---|
| 73 | I YSK=1 S YSYDT=YSA(+YSK) K YSA QUIT
|
|---|
| 74 | SL1 ;
|
|---|
| 75 | R !!?3,"Enter EXAM NUMBER to edit or",!?8,"Enter <CR> to create NEW exam: ",YSX:DTIME
|
|---|
| 76 | S YSTOUT='$T,YSUOUT=YSX["^" I YSTOUT!(YSUOUT) QUIT
|
|---|
| 77 | D:YSX="" CHK2^YSPHY1 QUIT:YSX=""
|
|---|
| 78 | S X1=$E(YSX)
|
|---|
| 79 | D:X1="?" HLP4^YSPHY1
|
|---|
| 80 | I +YSX'=YSX W " ?? ",$C(7) G SL1
|
|---|
| 81 | I '($D(YSA(+YSX))#2) W:YSX'["?" $C(7)," ?" G SL1
|
|---|
| 82 | S YSLDT=9999999-YSA(+YSX) S YSYDT=YSA(+YSX) K YSA Q
|
|---|
| 83 | Q
|
|---|
