Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSASES

YSASES.m

Go to the documentation of this file.
  1. YSASES ;ALB/ASF-ASI SIGNER ;3/19/97 16:47
  1. ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
  1. MAIN ;
  1. N YSASC,YSASCL,YSASDT,YSASFLD,YSASG,YSASNUM,YSASPT,YSASTRN,YSASX,YSL,YSOK
  1. I '$D(^YSTX(604,"A.81."_DUZ)) W !,"There are no completed ASIs for you to sign or incomplete ASIs",!,"for you to finish.",*7 H 2 Q
  1. K ^TMP($J,"YSASI")
  1. D TLD,TLP
  1. W !
  1. K DIR S DIR(0)="NA^1:"_YSASC_":0",DIR("A")="Select ASI number: (1:"_YSASC_") " D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S YSASSIEN=+^TMP($J,"YSASI",Y),YSOK=$P(^(Y),U,6)
  1. S YSASPIEN=$$GET1^DIQ(604,YSASSIEN_",",.02,"I")
  1. D ACTION
  1. G MAIN
  1. Q
  1. ACTION ;
  1. K DIR S DIR(0)=$S(YSOK:"SB^V:View;S:Sign;Q:Quit",1:"SB^V:View;E:Edit;Q:Quit"),DIR("A")="Action",DIR("B")="Q"
  1. D ^DIR K DIR
  1. I Y="V" D EN1^YSASPRT(YSASSIEN) K DIRUT Q
  1. I Y="S" D EN^YSASSN(YSASSIEN) Q
  1. I Y="E" D MAIN^YSASA2(YSASPIEN,YSASSIEN)
  1. Q
  1. TLD ;load ASI SIGNING list
  1. K ^TMP($J,"YSASI")
  1. S YSASIEN=0,YSASC=0
  1. F S YSASIEN=$O(^YSTX(604,"A.81."_DUZ,YSASIEN)) Q:YSASIEN'>0 D
  1. . S YSASC=YSASC+1
  1. . S YSASCL=$$GET1^DIQ(604,YSASIEN_",",.04)
  1. . S YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05)
  1. . S YSASTRN=$$GET1^DIQ(604,YSASIEN_",",.14)
  1. . S YSASPT=$$GET1^DIQ(604,YSASIEN_",",.02)
  1. . D CHECKALL^YSASO2(+YSASIEN,.YSOK)
  1. . S ^TMP($J,"YSASI",YSASC)=YSASIEN_U_YSASDT_U_YSASPT_U_YSASCL_U_YSASTRN_U_YSOK
  1. ;
  1. Q
  1. TLP ; print list
  1. Q:'$D(^TMP($J,"YSASI"))
  1. S YSL="",$P(YSL,"_",75)=""
  1. W @IOF
  1. W @IOF,"Addiction Severity Index Sign Off Utility",!?7,"*=incomplete x=some questions X or N",!
  1. W ?8,"Date",?19,"Patient",?51,"Entered by",!,YSL,!
  1. S YSASNUM=0
  1. F S YSASNUM=$O(^TMP($J,"YSASI",YSASNUM)) Q:YSASNUM'>0 D Q:$D(DIRUT)
  1. . S YSASG=^TMP($J,"YSASI",YSASNUM)
  1. . W !,$J(YSASNUM,3),$S($P(YSASG,U,6)=1:" ",$P(YSASG,U,6)=2:"x ",1:"* ")
  1. . W $P(YSASG,U,2)
  1. . W ?19,$P(YSASG,U,3)
  1. . W ?51,$P(YSASG,U,5)
  1. . D:$Y+4>IOSL WAIT
  1. Q
  1. ;
  1. WAIT ;
  1. F I0=1:1:IOSL-$Y-2 W !
  1. N DTOUT,DUOUT,DIRUT
  1. I IOST?1"C".E W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. W @IOF
  1. W ?8,"Date",?19,"Patient",?51,"Entered by",!,YSL,!
  1. Q