- 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 Jan 18, 2025@03:14:12 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