YSASFM ;ASF/ALB,HIOFO/FT - FILEMAN ASI REPORTS ;2/5/13 1:28pm
;;5.01;MENTAL HEALTH;**24,30,32,37,38,55,76,121**;Dec 30, 1994;Build 61
;Reference to ^VA(200, supported by DBIA #10060
Q
INTDATE ;interviewer by date
;entry point for YSAS ASI INTERVIEWER REPORT option
N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
D TOP("ASI Report by Interviewer")
S DIC="^YSTX(604,",L=0,FLDS="[YS ASI INTERVIEWER BY DATE]",BY="+.09,.05",DIPCRIT=1 D EN1^DIP
Q
SINGLEI ;single interviewer
;entry point for YSAS ASI SINGLE INTERVIEWER option
N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
D TOP("ASI Report by Single Interviewer")
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Select ASI Interviewer: " D ^DIC Q:Y'>0 S YSINT=$P(Y,U,2)
S DIC="^YSTX(604,",L=0,FLDS="[YS ASI INTERVIEWER BY DATE]",BY="+.09,.05",DIPCRIT=1
S FR(1)=YSINT,TO(1)=YSINT,FR(2)="?",TO(2)="?"
D EN1^DIP
Q
ALPHADT ; Name by date
;entry point for YSAS ASI BY PATIENT option
N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
D TOP("ASI Report by Patient Name")
S DIC="^YSTX(604,",L=0,FLDS="[YS ASI NAME BY DATE]"
S BY=".02,.05",DIPCRIT=1 D EN1^DIP
Q
UNSIGN ;incomplete ASIs
;entry point for YSAS ASI INCOMPLETE option
N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
D TOP("Incomplete ASI Report")
S DIC="^YSTX(604,",L=0,FLDS="[YS ASI NAME BY DATE]"
S BY="@.51,.05",FR="@,?",TO="@,?",DIPCRIT=1,DHD="Incomplete ASI Administrations" D EN1^DIP
Q
DTORD ;date sort
;entry point for YSAS ASI DATE ORDER option
N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
D TOP("ASI Report by Interview Date")
S DIC="^YSTX(604,",L=0,FLDS="[YS ASI NAME BY DATE]"
S BY=".05,.02",DIPCRIT=1 D EN1^DIP
Q
SSNORD ;order by SSN
;entry point for YSAS ASI SSN ORDER option
N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
D TOP("ASI Report by Social Security Number")
S DIC="^YSTX(604,",L=0,FLDS="[YS ASI BY SSN]"
S BY="@.0209,.05",FR=",?",TO=FR,DIPCRIT=1 D EN1^DIP
Q
TOP(X) ;HEADING
W @IOF,!?15,"***** ",X," *****",!,"please queue all reports",!
Q
PARAM ;edit ASI Parameters file
;entry point for YSAS ASI PARAMETERS option
W @IOF,!,"***** Edit ASI Site Parameters *****",!
S DIE="^YSTX(604.8,",DA=1,DR=".02:2"
L +^YSTX(604.8,DA):9999 Q:'$T
D ^DIE
L -^YSTX(604.8,DA)
Q
PROGRAM ;activate/inactivate programs
;entry point for YSAS ASI PROGRAM ACTIVATION option
N DIC,DIE,DR,DA,X,Y
S DIC="^YSTX(604.26,",DIC(0)="AEQ" D ^DIC Q:Y'>0
S DA=+Y,DIE=DIC,DR=3
L +^YSTX(604.26,DA):9999 Q:'$T
D ^DIE
L -^YSTX(604.26,DA)
G PROGRAM
;
CLEAR ; delete UNSIGNED ASI
;entry point for YSAS ASI DATA DELETION option
K ^TMP($J,"YSASI")
D PT^YSASSEL
Q:YSASPIEN<1
W @IOF,?25,"***** ASI Deletion Utility ****"
D TLD^YSASSEL,TLP^YSASSEL
W !
S DIR("A")="Select ASI number: " D ^DIR K DIR
Q:Y'?1N.N
S YSASSIEN=+^TMP($J,"YSASI",Y),YSASIG=$P(^TMP($J,"YSASI",Y),U,5)
I YSASIG W !!,"This ASI is signed and deletion is not permitted!",$C(7) Q
K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to delete this ASI",DIR("B")="N" D ^DIR
Q:Y'=1
S DA=YSASSIEN,DIK="^YSTX(604," D ^DIK
W !,"ASI deleted...."
Q
DEFED ;default editor
;entry point for YSAS ASI DEFAULT EDITOR option
N YSASIEN,DIC,DIE,DA,YSFIELD,YSFDA
W @IOF,?10,"*** ASI Default Editor ***",!
DEFED1 S DIC("A")="Select ASI Item: ",DIC="^YSTX(604.66,",DIC(0)="AEQM" D ^DIC
Q:Y'>0
S YSASIEN=+Y,YSFIELD=$P(^YSTX(604.66,YSASIEN,0),U,3)
S YSFDA="^TMP($J,""YSASI"")"
W !
D HELP^DIE(604,"",YSFIELD,"A",YSFDA),MSG^DIALOG("WH","","","",YSFDA)
S DIE="^YSTX(604.66,",DA=YSASIEN,DR=6
L +^YSTX(604.66,DA):9999 Q:'$T
D ^DIE
L -^YSTX(604.66,DA)
G DEFED1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASFM 3701 printed Oct 16, 2024@18:13:48 Page 2
YSASFM ;ASF/ALB,HIOFO/FT - FILEMAN ASI REPORTS ;2/5/13 1:28pm
+1 ;;5.01;MENTAL HEALTH;**24,30,32,37,38,55,76,121**;Dec 30, 1994;Build 61
+2 ;Reference to ^VA(200, supported by DBIA #10060
+3 QUIT
INTDATE ;interviewer by date
+1 ;entry point for YSAS ASI INTERVIEWER REPORT option
+2 NEW DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
+3 DO TOP("ASI Report by Interviewer")
+4 SET DIC="^YSTX(604,"
SET L=0
SET FLDS="[YS ASI INTERVIEWER BY DATE]"
SET BY="+.09,.05"
SET DIPCRIT=1
DO EN1^DIP
+5 QUIT
SINGLEI ;single interviewer
+1 ;entry point for YSAS ASI SINGLE INTERVIEWER option
+2 NEW DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
+3 DO TOP("ASI Report by Single Interviewer")
+4 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select ASI Interviewer: "
DO ^DIC
if Y'>0
QUIT
SET YSINT=$PIECE(Y,U,2)
+5 SET DIC="^YSTX(604,"
SET L=0
SET FLDS="[YS ASI INTERVIEWER BY DATE]"
SET BY="+.09,.05"
SET DIPCRIT=1
+6 SET FR(1)=YSINT
SET TO(1)=YSINT
SET FR(2)="?"
SET TO(2)="?"
+7 DO EN1^DIP
+8 QUIT
ALPHADT ; Name by date
+1 ;entry point for YSAS ASI BY PATIENT option
+2 NEW DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
+3 DO TOP("ASI Report by Patient Name")
+4 SET DIC="^YSTX(604,"
SET L=0
SET FLDS="[YS ASI NAME BY DATE]"
+5 SET BY=".02,.05"
SET DIPCRIT=1
DO EN1^DIP
+6 QUIT
UNSIGN ;incomplete ASIs
+1 ;entry point for YSAS ASI INCOMPLETE option
+2 NEW DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
+3 DO TOP("Incomplete ASI Report")
+4 SET DIC="^YSTX(604,"
SET L=0
SET FLDS="[YS ASI NAME BY DATE]"
+5 SET BY="@.51,.05"
SET FR="@,?"
SET TO="@,?"
SET DIPCRIT=1
SET DHD="Incomplete ASI Administrations"
DO EN1^DIP
+6 QUIT
DTORD ;date sort
+1 ;entry point for YSAS ASI DATE ORDER option
+2 NEW DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
+3 DO TOP("ASI Report by Interview Date")
+4 SET DIC="^YSTX(604,"
SET L=0
SET FLDS="[YS ASI NAME BY DATE]"
+5 SET BY=".05,.02"
SET DIPCRIT=1
DO EN1^DIP
+6 QUIT
SSNORD ;order by SSN
+1 ;entry point for YSAS ASI SSN ORDER option
+2 NEW DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
+3 DO TOP("ASI Report by Social Security Number")
+4 SET DIC="^YSTX(604,"
SET L=0
SET FLDS="[YS ASI BY SSN]"
+5 SET BY="@.0209,.05"
SET FR=",?"
SET TO=FR
SET DIPCRIT=1
DO EN1^DIP
+6 QUIT
TOP(X) ;HEADING
+1 WRITE @IOF,!?15,"***** ",X," *****",!,"please queue all reports",!
+2 QUIT
PARAM ;edit ASI Parameters file
+1 ;entry point for YSAS ASI PARAMETERS option
+2 WRITE @IOF,!,"***** Edit ASI Site Parameters *****",!
+3 SET DIE="^YSTX(604.8,"
SET DA=1
SET DR=".02:2"
+4 LOCK +^YSTX(604.8,DA):9999
if '$TEST
QUIT
+5 DO ^DIE
+6 LOCK -^YSTX(604.8,DA)
+7 QUIT
PROGRAM ;activate/inactivate programs
+1 ;entry point for YSAS ASI PROGRAM ACTIVATION option
+2 NEW DIC,DIE,DR,DA,X,Y
+3 SET DIC="^YSTX(604.26,"
SET DIC(0)="AEQ"
DO ^DIC
if Y'>0
QUIT
+4 SET DA=+Y
SET DIE=DIC
SET DR=3
+5 LOCK +^YSTX(604.26,DA):9999
if '$TEST
QUIT
+6 DO ^DIE
+7 LOCK -^YSTX(604.26,DA)
+8 GOTO PROGRAM
+9 ;
CLEAR ; delete UNSIGNED ASI
+1 ;entry point for YSAS ASI DATA DELETION option
+2 KILL ^TMP($JOB,"YSASI")
+3 DO PT^YSASSEL
+4 if YSASPIEN<1
QUIT
+5 WRITE @IOF,?25,"***** ASI Deletion Utility ****"
+6 DO TLD^YSASSEL
DO TLP^YSASSEL
+7 WRITE !
+8 SET DIR("A")="Select ASI number: "
DO ^DIR
KILL DIR
+9 if Y'?1N.N
QUIT
+10 SET YSASSIEN=+^TMP($JOB,"YSASI",Y)
SET YSASIG=$PIECE(^TMP($JOB,"YSASI",Y),U,5)
+11 IF YSASIG
WRITE !!,"This ASI is signed and deletion is not permitted!",$CHAR(7)
QUIT
+12 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to delete this ASI"
SET DIR("B")="N"
DO ^DIR
+13 if Y'=1
QUIT
+14 SET DA=YSASSIEN
SET DIK="^YSTX(604,"
DO ^DIK
+15 WRITE !,"ASI deleted...."
+16 QUIT
DEFED ;default editor
+1 ;entry point for YSAS ASI DEFAULT EDITOR option
+2 NEW YSASIEN,DIC,DIE,DA,YSFIELD,YSFDA
+3 WRITE @IOF,?10,"*** ASI Default Editor ***",!
DEFED1 SET DIC("A")="Select ASI Item: "
SET DIC="^YSTX(604.66,"
SET DIC(0)="AEQM"
DO ^DIC
+1 if Y'>0
QUIT
+2 SET YSASIEN=+Y
SET YSFIELD=$PIECE(^YSTX(604.66,YSASIEN,0),U,3)
+3 SET YSFDA="^TMP($J,""YSASI"")"
+4 WRITE !
+5 DO HELP^DIE(604,"",YSFIELD,"A",YSFDA)
DO MSG^DIALOG("WH","","","",YSFDA)
+6 SET DIE="^YSTX(604.66,"
SET DA=YSASIEN
SET DR=6
+7 LOCK +^YSTX(604.66,DA):9999
if '$TEST
QUIT
+8 DO ^DIE
+9 LOCK -^YSTX(604.66,DA)
+10 GOTO DEFED1
