[613] | 1 | YSASPNT ;ALB/ASF-TIU PROGRESS NOTE ;10/16/01 10:23
|
---|
| 2 | ;;5.01;MENTAL HEALTH;**39,73,88**;Dec 30, 1994
|
---|
| 3 | MAIN(YSASDA) ;
|
---|
| 4 | N VA,VADM,YSASAUTH,YSASC,YSAUTOSG,YSNOW,YSPIFN,YSTIUT,YSTIUTS,G,G2,N,P1,P2,R,V,V1,Y1,YSA,YSAGE,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSASWP
|
---|
| 5 | N YSASWP,YSBID,YSDOB,YSHDR,YSHIML,YSHIMU,YSI,YSJ,YSLAST,YSLCK,YSLFN,YSNM,YSPART,YSPOSL,YSPOSU
|
---|
| 6 | N YSPROL,YSPROU,YSSC,YSSCK,YSSEX,YSSSN,YSSTEM,YSTITLE,YSX,YSYCK,YSYX,YSZ,YSZZ,YSV1,YSV2,YSV3,YSV4,YSV5,YSV6,YSV7,YSV8,YSV9,YSV10,YSV11,YSV12,YSV13,YSV14
|
---|
| 7 | S Y=$$GET1^DIQ(604,YSASDA,.11,"I") Q:Y'="N" ;---> out if G12 10/16/01 ASF
|
---|
| 8 | S YSTIUT=0,YSTIUTS=0 D ASTIT
|
---|
| 9 | I (YSTIUT'>0)!(YSTIUTS'?1"ACT".E) W !,"ASI-TIU not fully ready" Q
|
---|
| 10 | K DIR S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you wish to create a TIU Progress Note" D ^DIR K DIR Q:$D(DIRUT)!(Y'=1)
|
---|
| 11 | K DIR S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you wish to automatically sign this note" D ^DIR K DIR Q:$D(DIRUT) S YSAUTOSG=+Y
|
---|
| 12 | D NARSET
|
---|
| 13 | D PUTPN
|
---|
| 14 | ;
|
---|
| 15 | Q
|
---|
| 16 | ASTIT ;ASI document title check
|
---|
| 17 | S X="ASI-ADDICTION SEVERITY INDEX",DIC="^TIU(8925.1,",DIC(0)="M",DIC("S")="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""" D ^DIC K DIC("S") S YSTIUT=+Y Q:YSTIUT'>0
|
---|
| 18 | S YSTIUTS=$$GET1^DIQ(8925.1,YSTIUT_",","STATUS")
|
---|
| 19 | Q
|
---|
| 20 | NARSET ;Set up narrative global
|
---|
| 21 | S YSZZ=0
|
---|
| 22 | S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
|
---|
| 23 | D DEM^VADPT
|
---|
| 24 | S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
|
---|
| 25 | S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
|
---|
| 26 | S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
|
---|
| 27 | S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
|
---|
| 28 | S YSASAUTH=$$GET1^DIQ(604,YSASDA_",",.09,"I")
|
---|
| 29 | S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSBID=VA("BID")
|
---|
| 30 | ;
|
---|
| 31 | K ^UTILITY($J,"YSTMP"),^TMP("TIUP",$J)
|
---|
| 32 | S YSLFN=1,^UTILITY($J,"YSTMP",0,1,0)=""
|
---|
| 33 | D VARPRO^YSASNAR
|
---|
| 34 | D R1^YSASNAR
|
---|
| 35 | M ^TMP("TIUP",$J)=^UTILITY($J,"YSTMP",0)
|
---|
| 36 | S X="NOW",%DT="T" D ^%DT S YSNOW=Y
|
---|
| 37 | S YSLFN=YSLFN-1,^TMP("TIUP",$J,0)="^^"_YSLFN_U_YSLFN_U_YSNOW_U
|
---|
| 38 | S YSLFN=0 F S YSLFN=$O(^TMP("TIUP",$J,YSLFN)) Q:YSLFN'>0 S:^TMP("TIUP",$J,YSLFN,0)?1"|BLANK".E ^TMP("TIUP",$J,YSLFN,0)=""
|
---|
| 39 | Q
|
---|
| 40 | PUTPN ;create Pnote
|
---|
| 41 | S YSAUTOSG=$S(YSAUTOSG:YSASAUTH,1:""),TIUASKVS=1
|
---|
| 42 | D NEW^TIUPNAPI(.YSPIFN,DFN,YSASAUTH,YSNOW,YSTIUT,"","","",YSAUTOSG,TIUASKVS)
|
---|
| 43 | ;VMP OIFO BAY PINES;ELR;YS*5.01*88 ADDED NEXT LINE OF CODE
|
---|
| 44 | S:$G(YSPIFN)=-1 YSPIFN=0
|
---|
| 45 | W !,$S(+YSPIFN:"Progress Note created",1:"Progress Note has NOT been created - please select the existing appointment") H 1
|
---|
| 46 | Q
|
---|