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

YSASFM.m

Go to the documentation of this file.
  1. 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
  1. ;Reference to ^VA(200, supported by DBIA #10060
  1. Q
  1. INTDATE ;interviewer by date
  1. ;entry point for YSAS ASI INTERVIEWER REPORT option
  1. N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
  1. D TOP("ASI Report by Interviewer")
  1. S DIC="^YSTX(604,",L=0,FLDS="[YS ASI INTERVIEWER BY DATE]",BY="+.09,.05",DIPCRIT=1 D EN1^DIP
  1. Q
  1. SINGLEI ;single interviewer
  1. ;entry point for YSAS ASI SINGLE INTERVIEWER option
  1. N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
  1. D TOP("ASI Report by Single Interviewer")
  1. S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Select ASI Interviewer: " D ^DIC Q:Y'>0 S YSINT=$P(Y,U,2)
  1. S DIC="^YSTX(604,",L=0,FLDS="[YS ASI INTERVIEWER BY DATE]",BY="+.09,.05",DIPCRIT=1
  1. S FR(1)=YSINT,TO(1)=YSINT,FR(2)="?",TO(2)="?"
  1. D EN1^DIP
  1. Q
  1. ALPHADT ; Name by date
  1. ;entry point for YSAS ASI BY PATIENT option
  1. N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
  1. D TOP("ASI Report by Patient Name")
  1. S DIC="^YSTX(604,",L=0,FLDS="[YS ASI NAME BY DATE]"
  1. S BY=".02,.05",DIPCRIT=1 D EN1^DIP
  1. Q
  1. UNSIGN ;incomplete ASIs
  1. ;entry point for YSAS ASI INCOMPLETE option
  1. N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
  1. D TOP("Incomplete ASI Report")
  1. S DIC="^YSTX(604,",L=0,FLDS="[YS ASI NAME BY DATE]"
  1. S BY="@.51,.05",FR="@,?",TO="@,?",DIPCRIT=1,DHD="Incomplete ASI Administrations" D EN1^DIP
  1. Q
  1. DTORD ;date sort
  1. ;entry point for YSAS ASI DATE ORDER option
  1. N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
  1. D TOP("ASI Report by Interview Date")
  1. S DIC="^YSTX(604,",L=0,FLDS="[YS ASI NAME BY DATE]"
  1. S BY=".05,.02",DIPCRIT=1 D EN1^DIP
  1. Q
  1. SSNORD ;order by SSN
  1. ;entry point for YSAS ASI SSN ORDER option
  1. N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
  1. D TOP("ASI Report by Social Security Number")
  1. S DIC="^YSTX(604,",L=0,FLDS="[YS ASI BY SSN]"
  1. S BY="@.0209,.05",FR=",?",TO=FR,DIPCRIT=1 D EN1^DIP
  1. Q
  1. TOP(X) ;HEADING
  1. W @IOF,!?15,"***** ",X," *****",!,"please queue all reports",!
  1. Q
  1. PARAM ;edit ASI Parameters file
  1. ;entry point for YSAS ASI PARAMETERS option
  1. W @IOF,!,"***** Edit ASI Site Parameters *****",!
  1. S DIE="^YSTX(604.8,",DA=1,DR=".02:2"
  1. L +^YSTX(604.8,DA):9999 Q:'$T
  1. D ^DIE
  1. L -^YSTX(604.8,DA)
  1. Q
  1. PROGRAM ;activate/inactivate programs
  1. ;entry point for YSAS ASI PROGRAM ACTIVATION option
  1. N DIC,DIE,DR,DA,X,Y
  1. S DIC="^YSTX(604.26,",DIC(0)="AEQ" D ^DIC Q:Y'>0
  1. S DA=+Y,DIE=DIC,DR=3
  1. L +^YSTX(604.26,DA):9999 Q:'$T
  1. D ^DIE
  1. L -^YSTX(604.26,DA)
  1. G PROGRAM
  1. ;
  1. CLEAR ; delete UNSIGNED ASI
  1. ;entry point for YSAS ASI DATA DELETION option
  1. K ^TMP($J,"YSASI")
  1. D PT^YSASSEL
  1. Q:YSASPIEN<1
  1. W @IOF,?25,"***** ASI Deletion Utility ****"
  1. D TLD^YSASSEL,TLP^YSASSEL
  1. W !
  1. S DIR("A")="Select ASI number: " D ^DIR K DIR
  1. Q:Y'?1N.N
  1. S YSASSIEN=+^TMP($J,"YSASI",Y),YSASIG=$P(^TMP($J,"YSASI",Y),U,5)
  1. I YSASIG W !!,"This ASI is signed and deletion is not permitted!",$C(7) Q
  1. K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to delete this ASI",DIR("B")="N" D ^DIR
  1. Q:Y'=1
  1. S DA=YSASSIEN,DIK="^YSTX(604," D ^DIK
  1. W !,"ASI deleted...."
  1. Q
  1. DEFED ;default editor
  1. ;entry point for YSAS ASI DEFAULT EDITOR option
  1. N YSASIEN,DIC,DIE,DA,YSFIELD,YSFDA
  1. W @IOF,?10,"*** ASI Default Editor ***",!
  1. DEFED1 S DIC("A")="Select ASI Item: ",DIC="^YSTX(604.66,",DIC(0)="AEQM" D ^DIC
  1. Q:Y'>0
  1. S YSASIEN=+Y,YSFIELD=$P(^YSTX(604.66,YSASIEN,0),U,3)
  1. S YSFDA="^TMP($J,""YSASI"")"
  1. W !
  1. D HELP^DIE(604,"",YSFIELD,"A",YSFDA),MSG^DIALOG("WH","","","",YSFDA)
  1. S DIE="^YSTX(604.66,",DA=YSASIEN,DR=6
  1. L +^YSTX(604.66,DA):9999 Q:'$T
  1. D ^DIE
  1. L -^YSTX(604.66,DA)
  1. G DEFED1