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

APCLPN.m

Go to the documentation of this file.
  1. APCLPN ; IHS/CMI/LAB - PROVIDER NARRATIVE/CODING QA REPORT ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;
  1. ;
  1. ;
  1. START ;
  1. I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! K APCLSITE Q
  1. S APCLJOB=$J,APCLBTH=$H
  1. D INFORM
  1. GETDATES ;
  1. BD ;
  1. S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) XIT
  1. S APCLBD=Y D DD^%DT S APCLBDD=Y
  1. ED ;
  1. S DIR(0)="D^::EP",DIR("A")="Enter Ending Visit Date",DIR("B")=APCLBDD D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) XIT
  1. I Y<APCLBD W !,"Ending date must be greater than or equal to beginning date!" G ED
  1. S APCLED=Y
  1. S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
  1. CHECK ;
  1. PRV ;
  1. S (APCLPROV,APCLDISC,APCLPSRT)=""
  1. S DIR(0)="SO^O:One Provider Only;P:All Providers;D:One Provider Discipline;A:All Provider Disciplines",DIR("A")="Report should include and sort by"
  1. S DIR("?")="If you wish to count only one provider of service enter a 'O'. To include ALL providers enter an 'A'. To include all providers of one discipline enter a 'D'." D ^DIR K DIR
  1. G:$D(DIRUT) XIT
  1. S APCLPSRT=Y
  1. I Y="P" S APCLPROV="" G PRIM
  1. G:Y="D" DISC
  1. I Y="X" S APCLCDIS="",APCLPSRT="P" G DISC
  1. I Y="A" S APCLDISC="" G PRIM
  1. PRV1 ;
  1. S DIC("A")="Which Provider: ",DIC="^DIC(6,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 PRV
  1. S APCLPROV=+Y
  1. G PRIM
  1. DISC ;
  1. S DIC("A")="Which Provider Discipline: ",DIC="^DIC(7,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 PRV
  1. S APCLDISC=+Y
  1. PRIM ;
  1. S DIR(0)="S^P:Primary Provider;S:Primary or Secondary Provider",DIR("A")="Include if Provider is",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) PRV
  1. I Y="P" S APCLPRIM=1 G ZIS
  1. S APCLPRIM=0
  1. ZIS ;
  1. S XBRP="^APCLPNP",XBRC="^APCLPN1",XBRX="XIT^APCLPN",XBNS="APCL"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
  1. XIT ;
  1. K APCLBD,APCLED,APCLBDD,APCLEDD,APCLVDFN,APCLVLOC,APCLLOC,APCLLOCT,APCLPROV,APCLPOS,APCLPROT,APCLPG,APCLBT,APCLSITE,APCLPRIM,APCLDT,APCLODAT,APCLSD,APCLVREC,APCL80S,APCLTOT,APCLCAT,APCLLENG,APCLTEXT,APCLTAB
  1. K APCLQUIT,APCLPROS,APCLDISC,APCLPSRT,APCLCDIS,APCLJOB,APCLBTH
  1. K DA,D0,S,TS,X,Y,DIC,DR,H,M,POP,ZTSK
  1. Q
  1. ;
  1. INFORM ;
  1. W:$D(IOF) @IOF
  1. W !,"This report is designed to allow Providers to compare the narrative",!,"that they enter for a diagnosis to the code/narrative that it gets coded to.",!,"Providers can then monitor the coding being done by the PCC Data entry Staff.",!
  1. Q
  1. ;