- 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 Feb 18, 2025@23:39:21 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