[613] | 1 | YSASNAR ;ALB/ASF SLC/DKG-ASI INTERVIEW REPORTER ;3/7/03 14:55
|
---|
| 2 | ;;5.01;MENTAL HEALTH;**24,30,37,38,44,55,67,76**;Dec 30, 1994
|
---|
| 3 | ;
|
---|
| 4 | ;Reference to ^%ZISC supported by IA #10089
|
---|
| 5 | ;Reference to ^%ZTLOAD supported by IA #10063
|
---|
| 6 | ;Reference to HOME^%ZIS supported by IA #1008
|
---|
| 7 | ;Reference to ^%ZIS supported by IA #10086
|
---|
| 8 | ;Reference to $$GET1^DIQ() supported by IA #2056
|
---|
| 9 | ;Reference to $$FMTE^XLFDT supported by IA #10103
|
---|
| 10 | ;Reference to DEM^VADPT supported by IA #10061
|
---|
| 11 | ;Reference to ^DIWP supported by IA #10011
|
---|
| 12 | ;Reference to ^DIR supported by IA #10026
|
---|
| 13 | ;Reference to ^DD("DD" supported by IA #10017
|
---|
| 14 | ;Reference to ^VA(200 supported by IA #10060
|
---|
| 15 | ;Reference to ^DPT( supported by IA #10035
|
---|
| 16 | ;
|
---|
| 17 | EN1(YSASDA) ;Entry point to display ASI
|
---|
| 18 | Q:$G(YSASDA)'>0
|
---|
| 19 | N YSASN,YSASNA,YSZZ,YSHDR,YSASD,YSAST,YSAS0,DIERR,YSI,YSASC,YSASN2
|
---|
| 20 | ;ASK DEVICE
|
---|
| 21 | N YSASQUIT,%ZIS,POP
|
---|
| 22 | S %ZIS="QM"
|
---|
| 23 | D ^%ZIS
|
---|
| 24 | Q:$G(POP)
|
---|
| 25 | I $D(IO("Q")) D Q
|
---|
| 26 | .N ZTRTN,ZTDESC,ZTSAVE
|
---|
| 27 | .S ZTRTN="QTEP^YSASNAR"
|
---|
| 28 | .S ZTDESC="YSASPRT ASI NARRATIVE PRINT"
|
---|
| 29 | .S ZTSAVE("YSASDA")=""
|
---|
| 30 | .D ^%ZTLOAD W:$D(ZTSK) !!,"Your Task Number is "_ZTSK
|
---|
| 31 | .D HOME^%ZIS
|
---|
| 32 | .Q
|
---|
| 33 | U IO
|
---|
| 34 | QTEP ;Queued Task Entry Point
|
---|
| 35 | S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 36 | N G,G2,N,P1,P2,R,V,V1,Y1,YSA,YSAGE,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSASWP
|
---|
| 37 | N YSASWP,YSBID,YSDOB,YSHDR,YSHIML,YSHIMU,YSI,YSJ,YSLAST,YSLCK,YSLFN,YSNM,YSPART,YSPOSL,YSPOSU
|
---|
| 38 | N YSPROL,YSPROU,YSSC,YSSCK,YSSEX,YSSSN,YSSTEM,YSTITLE,YSX,YSYCK,YSYX,YSZ,YSZZ
|
---|
| 39 | S YSZZ=0
|
---|
| 40 | S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
|
---|
| 41 | D DEM^VADPT
|
---|
| 42 | S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
|
---|
| 43 | S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
|
---|
| 44 | S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
|
---|
| 45 | S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
|
---|
| 46 | S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSBID=VA("BID")
|
---|
| 47 | S YSHDR=VADM(1)_" "_$P(VADM(2),U,2)_$J("",(20-$L(VADM(1))))_" ASI "_YSAST_" on "_YSASD_" by: "_YSASC
|
---|
| 48 | ;
|
---|
| 49 | MAIN ;
|
---|
| 50 | K ^UTILITY($J,"YSTMP"),^UTILITY($J,"W")
|
---|
| 51 | S YSLFN=1,^UTILITY($J,"YSTMP",0,1,0)=""
|
---|
| 52 | D VARPRO
|
---|
| 53 | D R1
|
---|
| 54 | D SIG
|
---|
| 55 | D PRT
|
---|
| 56 | D ^%ZISC
|
---|
| 57 | Q
|
---|
| 58 | R1 ;
|
---|
| 59 | S X=$S(YSAST?1"ASI-MV".E:"ASI-MV NARRATIVE",YSAST?1"FO".E:"FOLLOWUP NARRATIVE",1:"GENERAL"),YSPART=$O(^YSTX(604.68,"B",X,0))
|
---|
| 60 | F YSJ=1:1 Q:'$D(^YSTX(604.68,YSPART,1,YSJ,0)) S YSA=^(0) D R2
|
---|
| 61 | Q
|
---|
| 62 | R2 ;
|
---|
| 63 | I YSA?1"~".E Q
|
---|
| 64 | I YSA?1"W{".E1"}" K YSWP S YSWP=$$GET1^DIQ(604,YSASDA_",",$E(YSA,3,$L(YSA)-1),"Z","YSWP") D:YSWP'="" K YSWP Q
|
---|
| 65 | . S YSN2="" F S YSN2=$O(YSWP(YSN2)) Q:YSN2'>0 S YSLFN=YSLFN+1,^UTILITY($J,"YSTMP",0,YSLFN,0)=YSWP(YSN2,0)
|
---|
| 66 | ;
|
---|
| 67 | I YSA'["{" S X=YSA D:$L(X) L Q ;DIWL=0,DIWR=IOM,X=YSA D ^DIWP Q
|
---|
| 68 | PRO ;evaluate pronoun, possessive etc
|
---|
| 69 | F YSZ=1:1:999 Q:YSA'["{" D
|
---|
| 70 | . S P1=$F(YSA,"{")-1,P2=$F(YSA,"}")
|
---|
| 71 | . Q:'P1!'P2
|
---|
| 72 | . S G=$E(YSA,P1+1,P2-2),V=0
|
---|
| 73 | . I $P(G,";")?."."1N.NP D D CONDIT,ULP
|
---|
| 74 | .. S G2=$$GET1^DIQ(604,YSASDA_",",$P(G,";"),"","YSASWP")
|
---|
| 75 | .. S V=$S(G2?1N.N:+G2,1:G2) ;5/30 ASF
|
---|
| 76 | . S:G="Pro" V=$S(YSSEX="F":"She",1:"He")
|
---|
| 77 | . S:G="pro" V=$S(YSSEX="F":"she",1:"he")
|
---|
| 78 | . S:G="Pos" V=$S(YSSEX="F":"Her",1:"His")
|
---|
| 79 | . S:G="pos" V=$S(YSSEX="F":"her",1:"his")
|
---|
| 80 | . S:G="him" V=$S(YSSEX="F":"her",1:"him")
|
---|
| 81 | . S:G="himself" V=$S(YSSEX="F":"herself",1:"himself")
|
---|
| 82 | . S:G="Title" V=$S(YSSEX="F":"Ms.",1:"Mr.")
|
---|
| 83 | . I G="Blank" S:$L($G(^UTILITY($J,"YSTMP",0,YSLFN,0))) YSLFN=YSLFN+1 S ^UTILITY($J,"YSTMP",0,YSLFN,0)=$G(^UTILITY($J,"YSTMP",0,YSLFN,0))_"|BLANK(1)||NOBLANKLINE|",YSLFN=YSLFN+1,V=""
|
---|
| 84 | . S:G="Line" YSLFN=YSLFN+1,^UTILITY($J,"YSTMP",0,YSLFN,0)="",V=""
|
---|
| 85 | . I G="Last" S X=$P($P(^DPT(DFN,0),U),",") D
|
---|
| 86 | .. F %=2:1:$L(X) I $E(X,%)?1U,$E(X,%-1)?1A S X=$E(X,0,%-1)_$C($A(X,%)+32)_$E(X,%+1,999)
|
---|
| 87 | .. S V=X
|
---|
| 88 | . I $P(G,";")="Field" S @($P(G,";",2))=$$GET1^DIQ(604,YSASDA_",",$P(G,";",3)),V="" I $P(G,";",4)'="" S YSSC=";",YSX="S @($P(G,YSSC,2))=$S("_$P(G,";",4)_")" X YSX
|
---|
| 89 | . I $P(G,";")="List" K V D K V S V=""
|
---|
| 90 | .. S V1=$P(G,";",2),I1=0 F I=1:1 Q:$P(V1,",",I)="" S:@($P(V1,",",I))'="" I1=I1+1,V(I1)=@($P(V1,",",I))
|
---|
| 91 | .. I '$D(V(1)) S X=$P(G,";",3) D L Q
|
---|
| 92 | .. F I1=1:1 Q:'$D(V(I1)) S X=$S(I1=1:" ",'$D(V(I1+1)):" and ",1:", ")_V(I1) D L
|
---|
| 93 | R . S X=$E(YSA,1,P1-1) D:$L(X) L
|
---|
| 94 | . I $D(YSASWP) S V="" D K YSASWP
|
---|
| 95 | .. F I3=1:1 Q:'$D(YSASWP(I3)) S X=YSASWP(I3)_" " D:$L(X) L
|
---|
| 96 | . S X=V D:$L(X) L
|
---|
| 97 | . S YSA=$E(YSA,P2,999)
|
---|
| 98 | . I YSA'["{" S X=YSA D:$L(X) L
|
---|
| 99 | ;
|
---|
| 100 | Q
|
---|
| 101 | SIG ; signature
|
---|
| 102 | S YSLFN=YSLFN+1,^UTILITY($J,"YSTMP",0,YSLFN,0)=""
|
---|
| 103 | S YSLFN=YSLFN+1,^UTILITY($J,"YSTMP",0,YSLFN,0)="esig: "
|
---|
| 104 | S Y=$P($G(^YSTX(604,YSASDA,.5)),U,2) S:Y?1N.N Y=$G(^VA(200,Y,20)),Y=$P(Y,U,2)_" "_$P(Y,U,3)
|
---|
| 105 | S ^UTILITY($J,"YSTMP",0,YSLFN,0)=^UTILITY($J,"YSTMP",0,YSLFN,0)_Y
|
---|
| 106 | S Y=$G(^YSTX(604,YSASDA,12)) I Y'="" X ^DD("DD") S YSLFN=YSLFN+1,^UTILITY($J,"YSTMP",0,YSLFN,0)="signed: "_Y
|
---|
| 107 | Q
|
---|
| 108 | END ;
|
---|
| 109 | K I,YSLCK,R,YSSTEM,YSYX,YSYCK,YSSCK Q
|
---|
| 110 | L ;
|
---|
| 111 | S ^UTILITY($J,"YSTMP",0,YSLFN,0)=$G(^UTILITY($J,"YSTMP",0,YSLFN,0))_X
|
---|
| 112 | I $L(^UTILITY($J,"YSTMP",0,YSLFN,0))>80 D
|
---|
| 113 | . S Y=^UTILITY($J,"YSTMP",0,YSLFN,0)
|
---|
| 114 | . F I=$L(Y):-1:1 S Y1=$E(Y,I) I Y1=" "&(I<81) S ^UTILITY($J,"YSTMP",0,YSLFN,0)=$E(Y,1,I-1),YSLFN=YSLFN+1,^UTILITY($J,"YSTMP",0,YSLFN,0)=$E(Y,I+1,999) Q
|
---|
| 115 | Q
|
---|
| 116 | PRT ; Print output
|
---|
| 117 | W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
|
---|
| 118 | S N=0 F S N=$O(^UTILITY($J,"YSTMP",0,N)) Q:N'>0!YSZZ D
|
---|
| 119 | . S X=^UTILITY($J,"YSTMP",0,N,0),DIWL=1,DIWF="WN" D ^DIWP
|
---|
| 120 | . I IOT'="HFS" D:$Y+4>IOSL WAIT ;ASF 3/7/03
|
---|
| 121 | ;
|
---|
| 122 | Q
|
---|
| 123 | WAIT ;
|
---|
| 124 | F I0=1:1:IOSL-$Y-2 W !
|
---|
| 125 | N DTOUT,DUOUT,DIRUT
|
---|
| 126 | I IOST?1"C".E W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR S YSZZ=$D(DIRUT)
|
---|
| 127 | Q:YSZZ
|
---|
| 128 | W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
|
---|
| 129 | Q
|
---|
| 130 | TEST S G="X;;L",V="TEST"
|
---|
| 131 | ULP ;
|
---|
| 132 | Q:$P(G,";",3)=""
|
---|
| 133 | Q:$P(G,";",3)="P"&($P(G,";")=".09:20.3") ;MJD 01/06/2000
|
---|
| 134 | I $P(G,";",3)="P" F %=2:1:$L(V) I $E(V,%)?1U,$E(V,%-1)?1A S V=$E(V,0,%-1)_$C($A(V,%)+32)_$E(V,%+1,999)
|
---|
| 135 | I $P(G,";",3)="L" F %=1:1:$L(V) I $E(V,%)?1U S V=$E(V,0,%-1)_$C($A(V,%)+32)_$E(V,%+1,999)
|
---|
| 136 | I $P(G,";",3)="U" F %=1:1:$L(V) S:$E(V,%)?1L V=$E(V,0,%-1)_$C($A(V,%)-32)_$E(V,%+1,999)
|
---|
| 137 | Q
|
---|
| 138 | CONDIT ;conditional
|
---|
| 139 | Q:$P(G,";",2)=""
|
---|
| 140 | S YSX="S V=$S("_$P(G,";",2)_")"
|
---|
| 141 | ;S X=YSX D ^DIM
|
---|
| 142 | ;I '$D(X) S V="###ERROR Line "_YSJ_" ###" Q
|
---|
| 143 | X YSX
|
---|
| 144 | Q
|
---|
| 145 | VARPRO ; PATIENT VARIABLES
|
---|
| 146 | S YSPROU=$S(YSSEX="F":"She",1:"He")
|
---|
| 147 | S YSPROL=$S(YSSEX="F":"she",1:"he")
|
---|
| 148 | S YSPOSU=$S(YSSEX="F":"Her",1:"His")
|
---|
| 149 | S YSPOSL=$S(YSSEX="F":"her",1:"his")
|
---|
| 150 | S YSHIML=$S(YSSEX="F":"her",1:"him")
|
---|
| 151 | S YSHIMU=$S(YSSEX="F":"Her",1:"Him")
|
---|
| 152 | S YSTITLE=$S(YSSEX="F":"Ms.",1:"Mr.")
|
---|
| 153 | S X=$P($P(^DPT(DFN,0),U),",") D S YSLAST=X
|
---|
| 154 | . F %=2:1:$L(X) I $E(X,%)?1U,$E(X,%-1)?1A S X=$E(X,0,%-1)_$C($A(X,%)+32)_$E(X,%+1,999)
|
---|
| 155 | Q
|
---|