source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASPNT.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1YSASPNT ;ALB/ASF-TIU PROGRESS NOTE ;10/16/01 10:23
2 ;;5.01;MENTAL HEALTH;**39,73,88**;Dec 30, 1994
3MAIN(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
16ASTIT ;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
20NARSET ;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
40PUTPN ;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
Note: See TracBrowser for help on using the repository browser.