source: FOIAVistA/tag/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASPNT.m@ 636

YSASPNT ;ALB/ASF-TIU PROGRESS NOTE ;10/16/01  10:23
 ;;5.01;MENTAL HEALTH;**39,73,88**;Dec 30, 1994
MAIN(YSASDA) ;
 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
 N YSASWP,YSBID,YSDOB,YSHDR,YSHIML,YSHIMU,YSI,YSJ,YSLAST,YSLCK,YSLFN,YSNM,YSPART,YSPOSL,YSPOSU
 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
 S Y=$$GET1^DIQ(604,YSASDA,.11,"I") Q:Y'="N"  ;---> out if G12 10/16/01 ASF
 S YSTIUT=0,YSTIUTS=0 D ASTIT
 I (YSTIUT'>0)!(YSTIUTS'?1"ACT".E) W !,"ASI-TIU not fully ready" Q
 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)
 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
 D NARSET
 D PUTPN
 ;
 Q
ASTIT ;ASI document title check
 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
 S YSTIUTS=$$GET1^DIQ(8925.1,YSTIUT_",","STATUS")
 Q
NARSET ;Set up narrative global
 S YSZZ=0
 S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
 D DEM^VADPT
 S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
 S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
 S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
 S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
 S YSASAUTH=$$GET1^DIQ(604,YSASDA_",",.09,"I")
 S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSBID=VA("BID")
 ;
 K ^UTILITY($J,"YSTMP"),^TMP("TIUP",$J)
 S YSLFN=1,^UTILITY($J,"YSTMP",0,1,0)=""
 D VARPRO^YSASNAR
 D R1^YSASNAR
 M ^TMP("TIUP",$J)=^UTILITY($J,"YSTMP",0)
 S X="NOW",%DT="T" D ^%DT S YSNOW=Y
 S YSLFN=YSLFN-1,^TMP("TIUP",$J,0)="^^"_YSLFN_U_YSLFN_U_YSNOW_U
 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)=""
 Q
PUTPN ;create Pnote
 S YSAUTOSG=$S(YSAUTOSG:YSASAUTH,1:""),TIUASKVS=1
 D NEW^TIUPNAPI(.YSPIFN,DFN,YSASAUTH,YSNOW,YSTIUT,"","","",YSAUTOSG,TIUASKVS)
 ;VMP OIFO BAY PINES;ELR;YS*5.01*88 ADDED NEXT LINE OF CODE
 S:$G(YSPIFN)=-1 YSPIFN=0
 W !,$S(+YSPIFN:"Progress Note created",1:"Progress Note has NOT been created - please select the existing appointment") H 1
 Q