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

APCLNJ1.m

Go to the documentation of this file.
  1. APCLNJ1 ; IHS/CMI/LAB - CLINIC VISITS BY DATE RANGE WITH POV ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;This report is to be used to list visits by clinic
  1. ;
  1. W:$D(IOF) @IOF W !!?20,"LISTING OF VISITS INJURY DIAGNOSES"
  1. W !!,"This report will list visits which have an injury diagnosis. The user",!,"can select which visits to print based on any of the following criteria:",!
  1. W ?15,"- Visit date",!?15,"- Clinic of Visit",!?15,"- Service Category of Visit",!?15,"- Type of Visit",!?15,"- Location of Encounter",!?15,"- Age Range",!!
  1. GETDATES ;
  1. BD ;get beginning date
  1. W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) G XIT
  1. S APCLBD=Y
  1. ED ;get ending date
  1. W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date: " S Y=APCLBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) G BD
  1. S APCLED=Y
  1. S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
  1. ;
  1. ;
  1. LOC ;
  1. K APCLLOC,APCLLOCT
  1. W ! S DIR(0)="YO",DIR("A")="Include visits from ALL Locations",DIR("B")="Yes"
  1. S DIR("?")="If you wish to include visits from ALL locations answer Yes. If you wish to list visits for only one location of encounter enter NO."
  1. D ^DIR K DIR
  1. G:$D(DIRUT) BD
  1. I Y=1 G TYPE
  1. LOC1 ;enter location
  1. S X="LOCATION OF ENCOUNTER",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1. D PEP^AMQQGTX0(+Y,"APCLLOCT(")
  1. I '$D(APCLLOCT) G LOC
  1. I $D(APCLLOCT("*")) K APCLLOCT
  1. TYPE ;
  1. K APCLTYP,APCLTYPT
  1. W ! S DIR(0)="YO",DIR("A")="Include ALL Visit Types",DIR("B")="Yes"
  1. S DIR("?")="If you wish to include all Visit Types (IHS,CONTRACT,638,etc) answer Yes. If you wish to list visits for only one visit type enter NO."
  1. D ^DIR K DIR
  1. G:$D(DIRUT) LOC
  1. I Y=1 G SC
  1. TYPE1 ;
  1. S X="VISIT TYPE",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1. D PEP^AMQQGTX0(+Y,"APCLTYPT(")
  1. I '$D(APCLTYPT) G TYPE
  1. I $D(APCLTYPT("*")) K APCLTYPT
  1. SC ;
  1. K APCLSCT
  1. K APCLSC,APCLSCT W ! S DIR(0)="YO",DIR("A")="Include ALL Visit Service Categories",DIR("B")="Yes"
  1. S DIR("?")="If you wish to include all visit service categories (Ambulatory,Hospitalization,etc) answer Yes. If you wish to list visits for only one service category enter NO." D ^DIR K DIR
  1. G:$D(DIRUT) BD
  1. I Y=1 G CLINIC
  1. SC1 ;enter sc
  1. S X="SERVICE CATEGORY",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1. D PEP^AMQQGTX0(+Y,"APCLSCT(")
  1. I '$D(APCLSCT) G SC
  1. I $D(APCLSCT("*")) K APCLSCT
  1. CLINIC ;
  1. K APCLCLNT
  1. W ! S DIR(0)="Y",DIR("A")="Include visits to ALL clinics",DIR("B")="Yes" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) SC
  1. I Y=1 G AGE
  1. CLINIC1 ;
  1. S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1. D PEP^AMQQGTX0(+Y,"APCLCLNT(")
  1. I '$D(APCLCLNT) G CLINIC
  1. I $D(APCLCLNT("*")) K APCLCLNT
  1. AGE ;Age Screening
  1. K APCLAGE,APCLAGET
  1. W ! S DIR(0)="YO",DIR("A")="Would you like to restrict the report by Patient age range",DIR("B")="YES"
  1. S DIR("?")="If you wish to include visits from ALL age ranges, anwser No. If you wish to list visits for only patients within a particular age range, enter Yes."
  1. D ^DIR K DIR
  1. G:$D(DIRUT) CLINIC
  1. I 'Y G ZIS
  1. ;
  1. AGER ;Age Screening
  1. W !
  1. S DIR(0)="FO^1:7",DIR("A")="Enter an Age Range (e.g. 5-12,1-1)" D ^DIR
  1. I Y="" W !!,"No age range entered." G AGE
  1. I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20." G AGER
  1. S APCLAGET=Y
  1. ZIS ;
  1. DEMO ;
  1. D DEMOCHK^APCLUTL(.APCLDEMO)
  1. I APCLDEMO=-1 G AGE
  1. S XBRC="^APCLNJ11",XBRP="^APCLNJ12",XBNS="APCL",XBRX="XIT^APCLNJ1"
  1. D ^XBDBQUE
  1. XIT K Y,APCLBD,APCLED,APCLCL,APCLICD,APCLBICD,APCLEICD,ZTSK,ZTQUEUED,%DT,APCLBT,APCLSD,APCLJOB,APCLPROV,APCLFOUN,APCLDFN,APCLCLNT,APCLLOCT,APCLSCT,APCLTYPT,APCLAGE,APCLAGET
  1. K APCL65,APCLBD,APCLCLS,APCLED,APCLFPV,APCLFVS,APCLIOM,APCLMCR,DA,DFN,%DT,%T,%Y,APCLAGE,G,POP,AMQQTAX,AMQQTDFN,APCLBDD,APCLEDD,APCLFR,APCLPA,APCLPOV,APCLSC,APCLTYPE
  1. K APCLNAME,APCLNAR,APCLPRC,APCLPRV,APCLPS,APCLPTOT,APCLPV,APCLSTR
  1. K APCLSTOP,APCLVDFN,APCLVDT,APCLVPOV,APCLVPRC,APCLVRV,APCLVTOT,Y
  1. K DIC,DOB,DR,APCLHRCN,I,LKPRINT,SEX,APCLSTR,X,APCLCLX,APCLCL,APCLPGRD
  1. K AMQQATN,AMQQCOMP,AMQQCTXS,AMQQLINK,AMQQTAX
  1. K APCLVGRA,APCLPAGE,APCLICD,APCLBICD,APCLEICD,APCLPV,APCLPRC,APCLFLG
  1. Q