47 lines
2.3 KiB
Mathematica
47 lines
2.3 KiB
Mathematica
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
|