YSASES ;ALB/ASF-ASI SIGNER ;3/19/97 16:47
;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
MAIN ;
N YSASC,YSASCL,YSASDT,YSASFLD,YSASG,YSASNUM,YSASPT,YSASTRN,YSASX,YSL,YSOK
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
K ^TMP($J,"YSASI")
D TLD,TLP
W !
K DIR S DIR(0)="NA^1:"_YSASC_":0",DIR("A")="Select ASI number: (1:"_YSASC_") " D ^DIR K DIR
Q:$D(DIRUT)
S YSASSIEN=+^TMP($J,"YSASI",Y),YSOK=$P(^(Y),U,6)
S YSASPIEN=$$GET1^DIQ(604,YSASSIEN_",",.02,"I")
D ACTION
G MAIN
Q
ACTION ;
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"
D ^DIR K DIR
I Y="V" D EN1^YSASPRT(YSASSIEN) K DIRUT Q
I Y="S" D EN^YSASSN(YSASSIEN) Q
I Y="E" D MAIN^YSASA2(YSASPIEN,YSASSIEN)
Q
TLD ;load ASI SIGNING list
K ^TMP($J,"YSASI")
S YSASIEN=0,YSASC=0
F S YSASIEN=$O(^YSTX(604,"A.81."_DUZ,YSASIEN)) Q:YSASIEN'>0 D
. S YSASC=YSASC+1
. S YSASCL=$$GET1^DIQ(604,YSASIEN_",",.04)
. S YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05)
. S YSASTRN=$$GET1^DIQ(604,YSASIEN_",",.14)
. S YSASPT=$$GET1^DIQ(604,YSASIEN_",",.02)
. D CHECKALL^YSASO2(+YSASIEN,.YSOK)
. S ^TMP($J,"YSASI",YSASC)=YSASIEN_U_YSASDT_U_YSASPT_U_YSASCL_U_YSASTRN_U_YSOK
;
Q
TLP ; print list
Q:'$D(^TMP($J,"YSASI"))
S YSL="",$P(YSL,"_",75)=""
W @IOF
W @IOF,"Addiction Severity Index Sign Off Utility",!?7,"*=incomplete x=some questions X or N",!
W ?8,"Date",?19,"Patient",?51,"Entered by",!,YSL,!
S YSASNUM=0
F S YSASNUM=$O(^TMP($J,"YSASI",YSASNUM)) Q:YSASNUM'>0 D Q:$D(DIRUT)
. S YSASG=^TMP($J,"YSASI",YSASNUM)
. W !,$J(YSASNUM,3),$S($P(YSASG,U,6)=1:" ",$P(YSASG,U,6)=2:"x ",1:"* ")
. W $P(YSASG,U,2)
. W ?19,$P(YSASG,U,3)
. W ?51,$P(YSASG,U,5)
. D:$Y+4>IOSL WAIT
Q
;
WAIT ;
F I0=1:1:IOSL-$Y-2 W !
N DTOUT,DUOUT,DIRUT
I IOST?1"C".E W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR
Q:$D(DIRUT)
W @IOF
W ?8,"Date",?19,"Patient",?51,"Entered by",!,YSL,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASES 2023 printed Dec 13, 2024@02:13:04 Page 2
YSASES ;ALB/ASF-ASI SIGNER ;3/19/97 16:47
+1 ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
MAIN ;
+1 NEW YSASC,YSASCL,YSASDT,YSASFLD,YSASG,YSASNUM,YSASPT,YSASTRN,YSASX,YSL,YSOK
+2 IF '$DATA(^YSTX(604,"A.81."_DUZ))
WRITE !,"There are no completed ASIs for you to sign or incomplete ASIs",!,"for you to finish.",*7
HANG 2
QUIT
+3 KILL ^TMP($JOB,"YSASI")
+4 DO TLD
DO TLP
+5 WRITE !
+6 KILL DIR
SET DIR(0)="NA^1:"_YSASC_":0"
SET DIR("A")="Select ASI number: (1:"_YSASC_") "
DO ^DIR
KILL DIR
+7 if $DATA(DIRUT)
QUIT
+8 SET YSASSIEN=+^TMP($JOB,"YSASI",Y)
SET YSOK=$PIECE(^(Y),U,6)
+9 SET YSASPIEN=$$GET1^DIQ(604,YSASSIEN_",",.02,"I")
+10 DO ACTION
+11 GOTO MAIN
+12 QUIT
ACTION ;
+1 KILL DIR
SET DIR(0)=$SELECT(YSOK:"SB^V:View;S:Sign;Q:Quit",1:"SB^V:View;E:Edit;Q:Quit")
SET DIR("A")="Action"
SET DIR("B")="Q"
+2 DO ^DIR
KILL DIR
+3 IF Y="V"
DO EN1^YSASPRT(YSASSIEN)
KILL DIRUT
QUIT
+4 IF Y="S"
DO EN^YSASSN(YSASSIEN)
QUIT
+5 IF Y="E"
DO MAIN^YSASA2(YSASPIEN,YSASSIEN)
+6 QUIT
TLD ;load ASI SIGNING list
+1 KILL ^TMP($JOB,"YSASI")
+2 SET YSASIEN=0
SET YSASC=0
+3 FOR
SET YSASIEN=$ORDER(^YSTX(604,"A.81."_DUZ,YSASIEN))
if YSASIEN'>0
QUIT
Begin DoDot:1
+4 SET YSASC=YSASC+1
+5 SET YSASCL=$$GET1^DIQ(604,YSASIEN_",",.04)
+6 SET YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05)
+7 SET YSASTRN=$$GET1^DIQ(604,YSASIEN_",",.14)
+8 SET YSASPT=$$GET1^DIQ(604,YSASIEN_",",.02)
+9 DO CHECKALL^YSASO2(+YSASIEN,.YSOK)
+10 SET ^TMP($JOB,"YSASI",YSASC)=YSASIEN_U_YSASDT_U_YSASPT_U_YSASCL_U_YSASTRN_U_YSOK
End DoDot:1
+11 ;
+12 QUIT
TLP ; print list
+1 if '$DATA(^TMP($JOB,"YSASI"))
QUIT
+2 SET YSL=""
SET $PIECE(YSL,"_",75)=""
+3 WRITE @IOF
+4 WRITE @IOF,"Addiction Severity Index Sign Off Utility",!?7,"*=incomplete x=some questions X or N",!
+5 WRITE ?8,"Date",?19,"Patient",?51,"Entered by",!,YSL,!
+6 SET YSASNUM=0
+7 FOR
SET YSASNUM=$ORDER(^TMP($JOB,"YSASI",YSASNUM))
if YSASNUM'>0
QUIT
Begin DoDot:1
+8 SET YSASG=^TMP($JOB,"YSASI",YSASNUM)
+9 WRITE !,$JUSTIFY(YSASNUM,3),$SELECT($PIECE(YSASG,U,6)=1:" ",$PIECE(YSASG,U,6)=2:"x ",1:"* ")
+10 WRITE $PIECE(YSASG,U,2)
+11 WRITE ?19,$PIECE(YSASG,U,3)
+12 WRITE ?51,$PIECE(YSASG,U,5)
+13 if $Y+4>IOSL
DO WAIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+14 QUIT
+15 ;
WAIT ;
+1 FOR I0=1:1:IOSL-$Y-2
WRITE !
+2 NEW DTOUT,DUOUT,DIRUT
+3 IF IOST?1"C".E
WRITE $CHAR(7)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 if $DATA(DIRUT)
QUIT
+5 WRITE @IOF
+6 WRITE ?8,"Date",?19,"Patient",?51,"Entered by",!,YSL,!
+7 QUIT
