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

APCDEGP.m

Go to the documentation of this file. 
  1. APCDEGP ; IHS/CMI/LAB - group preventive services group form ;
  1.  ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
  1.  ;
  1. START ;
  1.  D INIT
  1.  G:APCDQUIT EOJ
  1.  S APCDLOC="" F  D GETLOC Q:APCDLOC=""  S APCDTYPE="" F  D GETTYPE Q:APCDTYPE=""  S APCDCAT="" F  D GETCAT Q:APCDCAT=""  S APCDDATE="" F  D GETDATE Q:APCDDATE=""  D GETREST
  1.  D EOJ
  1.  Q
  1. GETREST ;
  1.  S APCDCLIN="" D GETCLN Q:'$D(APCDEGCL)  S APCDEGPR="" D PROV Q:APCDQUIT  S APCDPOV="" D POV Q:APCDQUIT  S APCDEDUC="" D EDUC Q:APCDQUIT
  1.  D DISPLAY I APCDQUIT W !!,"Okay, start over and re-enter the information.",! D EOP G START
  1.  K APCDEGP("FORMS")
  1.  S APCDPAT="" F  D GETPAT Q:APCDPAT=""
  1.  ;print forms?
  1. PRINT ;
  1.  Q:'$D(APCDEGP("FORMS"))
  1.  W !! S DIR(0)="Y",DIR("A")="Do you wish to PRINT a hard copy encounter form for each patient in the group",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q:$D(DIRUT)
  1.  Q:'Y
  1.  S XBRP="PRINT^APCDEGPP",XBRC="COMP^APCDEGPP",XBRX="XIT^APCDEGPP",XBNS="APCD"
  1.  D ^XBDBQUE
  1.  ;loop through all patients, records and print forms
  1.  W !!!!
  1.  Q
  1. INIT ; Write Header
  1.  D ^XBFMK K DIADD,DLAYGO
  1.  W:$D(IOF) @IOF
  1.  F APCDEGJ=1:1:5 S APCDEGX=$P($T(TEXT+APCDEGJ),";;",2) W !?80-$L(APCDEGX)\2,APCDEGX
  1.  K APCDEGX,APCDEGJ
  1.  W !!
  1.  S APCDQUIT=""
  1.  D ^APCDEIN
  1.  I APCDFLG S APCDQUIT=1 Q
  1.  S APCDMODE="A"
  1.  K ^TMP("APCDEGP",$J)
  1.  D KILL^AUPNPAT
  1.  Q
  1. EOJ ;
  1.  K ^TMP("APCDEGP",$J)
  1.  D EN2^APCDEKL
  1.  D ^APCDEKL
  1.  D EN^XBVK("APCD")
  1.  K AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOB,AUPNDOD
  1.  K %,%W,%Y,X,Y,DIR,DIRUT,DIC,DIE,DA,DR,DTOUT,DUOUT,%DT,DIU,DIV,DIW,DIPGM,DQ,DI,DIG,DIH,X1,X2,ZTSAVE
  1.  Q
  1. GETLOC ; GET LOCATION OF ENCOUNTER
  1.  D ^XBFMK
  1.  S APCDLOC=""
  1.  S DIC("A")="LOCATION OF GROUP VISIT: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA
  1.  Q:Y<0
  1.  S APCDLOC=+Y,APCDEGLC=$E($P(^AUTTLOC(APCDLOC,0),U,10),5,6)
  1.  Q
  1.  ;
  1. GETTYPE ; GET TYPE OF ENCOUNTER
  1.  K DIR,X,Y,DA
  1.  S APCDTYPE=""
  1.  S DIR(0)="9000010,.03O",DIR("A")="TYPE..................." D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  I X="" Q
  1.  S APCDTYPE=Y
  1.  Q
  1. GETCAT ; GET SERVICE CATEGORY
  1.  S APCDCAT=""
  1.  K DIR,DA,X,Y
  1.  S DIR(0)="9000010,.07O",DIR("A")="SERVICE CATEGORY......." D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  Q:X=""
  1.  S APCDCAT=Y
  1.  Q
  1.  ;
  1. GETDATE ; GET DATE OF ENCOUNTER
  1.  S APCDDATE=""
  1.  W !,"VISIT/ADMIT DATE.......: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X=""
  1.  Q:X=""!(X="^")
  1.  S %DT="ET" D ^%DT G:Y<0 GETDATE
  1.  I Y>DT W "  <Future dates not allowed>",$C(7),$C(7) K X G GETDATE
  1.  S APCDDATE=X
  1. GETTIME ;
  1.  S APCDTIME="12:00"
  1.  W !,"TIME OF VISIT..........: ",$S(APCDTIME]"":APCDTIME_"// ",1:"") R X:$S($D(DTIME):DTIME,1:300) S:'$T X="^" S:X="" X=APCDTIME
  1.  S APCDTIME=""
  1.  I X="^" S APCDDATE="" G GETDATE
  1.  I X="" W APCDBEEP,"  Time Required!" G GETTIME
  1.  I X["?" W !,"Enter time of visit, or 'D' for default." G GETTIME
  1.  I X="D" S X="12:00" W "  ",X
  1. EDTIME S APCDTIME=X,X=APCDDATE_"@"_APCDTIME
  1.  X ^TMP("APCD",$J,"APCDDATE")
  1.  I '$D(X) W APCDBEEP G GETDATE
  1.  I X="-1" W ! G GETDATE
  1.  S APCDDATE=X
  1.  Q
  1. GETCLN ;
  1.  D ^XBFMK
  1.  K APCDEGCL
  1.  S APCDCLIN="",DIC="^DIC(40.7,",DIC(0)="AEMQ",DIC("A")="CLINIC.................: " D ^DIC K DIC,DA
  1.  I Y=-1,X="" S APCDCLIN="" D CLNCHK Q
  1.  I Y=-1,X="^" S APCDCLIN="" Q
  1.  Q:Y<0
  1.  S APCDCLIN="`"_+Y,APCDEGCL=""
  1.  Q
  1. CLNCHK ;
  1.  I APCDCLIN="",APCDCAT="A","I6T"[APCDTYPE,APCDEGLC>0,APCDEGLC<50 W !,"WARNING:  No Clinic Type entered for this visit and clinic is required!",!,$C(7) Q
  1.  S APCDEGCL=""
  1.  Q
  1. PROV ;
  1.  K ^TMP("APCDEGP",$J,"PROV")
  1.  S APCDQUIT=0
  1.  S APCDEGC=0,(APCDEGPC,APCDEGPS,APCDEGPR)="" F  D PROV1^APCDEGP0 Q:APCDEGPR=""
  1.  I 'APCDEGPS W $C(7),$C(7),!!,"NO PRIMARY PROVIDER INDICATED!!!",!! S APCDEGPR="",APCDQUIT=1 Q
  1.  Q
  1. POV ;
  1.  K ^TMP("APCDEGP",$J,"POV")
  1.  S APCDQUIT=0
  1.  S APCDEGC=0,APCDPOV="" F  D POV1^APCDEGP0 Q:$D(DIRUT)!(APCDPOV="")
  1.  I APCDEGC=0 W !!,$C(7),$C(7),"NO PURPOSE OF VISIT ENTERED" S APCDQUIT=1 Q
  1.  Q
  1. EDUC ;
  1.  S DIR(0)="Y",DIR("A")="Any Patient Education to add to each patient's visit",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  Q:$D(DIRUT)
  1.  Q:Y=0
  1.  K ^TMP("APCDEGP",$J,"EDUC")
  1.  S APCDQUIT=0
  1.  S APCDEGC=0,APCDEDUC="" F  D EDUC1^APCDEGP0 Q:$D(DIRUT)!(APCDEDUC="")
  1.  I APCDEGC=0 W !!,$C(7),$C(7),"NO EDUCATION ENTERED" G EDUC
  1.  Q
  1. GETPAT ; GET PATIENT
  1.  S APCDPAT=""
  1.  D GETPAT^APCDEA
  1.  Q:APCDPAT=""
  1.  I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
  1. PROCESS ;process visit
  1.  D ^APCDEGP1
  1.  Q
  1.  ;
  1. DISPLAY ;display all info and do you want to continue
  1.  W !!!,"The following information will be used for the visits being created for",!,"this group form.  Please review the information for accuracy.",!
  1.  W !,"Visit Date:",?14,$$FMTE^XLFDT(APCDDATE),?40,"Type: ",$$EXTSET^XBFUNC(9000010,.03,APCDTYPE)
  1.  W !,"Location:",?14,$E($P(^DIC(4,APCDLOC,0),U),1,15),?40,"Service Category: ",$$EXTSET^XBFUNC(9000010,.07,APCDCAT)
  1.  W !,"Clinic:",?14,$S(APCDCLIN]"":$P(^DIC(40.7,$E(APCDCLIN,2,99),00),U),1:"")
  1.  S (X,C)=0 F  S X=$O(^TMP("APCDEGP",$J,"PROV",X)) Q:X'=+X  S C=C+1 D
  1.  .I C=1 W !!,"Providers:"
  1.  .S Y=$P(^TMP("APCDEGP",$J,"PROV",X,"APCDTPRV"),U),Y=$E(Y,2,99),Z=$P(^TMP("APCDEGP",$J,"PROV",X,"APCDTPRV"),U,2)
  1.  .W ?14,$P(^VA(200,Y,0),U),?46,$S(Z="P":"PRIMARY",1:"SECONDARY"),! Q
  1.  .;W ?14,$P(^DIC(16,Y,0),U),?46,$S(Z="P":"PRIMARY",1:"SECONDARY"),! Q
  1.  S (X,C)=0 F  S X=$O(^TMP("APCDEGP",$J,"POV",X)) Q:X'=+X  S C=C+1 D
  1.  .I C=1 W !,"POV's:"
  1.  .S Y=$P(^TMP("APCDEGP",$J,"POV",X,"APCDTPOV"),U),Y=$E(Y,2,99),Z=$P(^TMP("APCDEGP",$J,"POV",X,"APCDTPOV"),U,2),Z=$E(Z,2,99)
  1.  .W ?10,$P($$ICDDX^ICDEX(Y),U,2),?20,"Narrative: ",$P(^AUTNPOV(Z,0),U),!
  1.  S (X,C)=0 F  S X=$O(^TMP("APCDEGP",$J,"EDUC",X)) Q:X'=+X  S C=C+1 D
  1.  .I C=1 W !,"Education topics:"
  1.  .S Y=$P(^TMP("APCDEGP",$J,"EDUC",X,"APCDTTOP"),U),Y=$E(Y,2,99),Z=$P(^TMP("APCDEGP",$J,"EDUC",X,"APCDTTOP"),U,2),Z=$E(Z,2,99)
  1.  .W ?20,$P(^AUTTEDT(Y,0),U),?55,"Minutes: ",$P(^TMP("APCDEGP",$J,"EDUC",X,"APCDTTOP"),U,2),!
  1.  W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S APCDQUIT=1 Q
  1.  I 'Y S APCDQUIT=1 Q
  1. FORMID ;
  1.  ;generate form id in file
  1.  K DIC,DO,DD,D0 S X="XXX",DIC(0)="L",DIC="^APCDGRP(",DIADD=1,DLAYGO=9001002.3,DIC("DR")=".02////"_DUZ_";.03////"_DT_";.04////"_APCDDATE D FILE^DICN I Y=-1 D  Q
  1.  .D ^XBFMK K DIADD,DLAYGO,DLAYGO,DR,DD S APCDQUIT=1 W !!,"Failure to create FORM ID.  Notify programmer.",! Q
  1.  S APCDFID=+Y
  1.  K DIADD,DLAYGO D ^XBFMK
  1.  S DA=APCDFID,Z="G"_APCDFID,DIE="^APCDGRP(",DR=".01///"_Z D ^DIE K DIE,DR,DA
  1.  W !!,"The form ID for this group form is ",$P(^APCDGRP(APCDFID,0),U),".",!,"Please make a note of this.  It will be needed if and when you need to ",!,"re-print forms.",!!
  1.  Q
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="Press Enter",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. TEXT ;
  1.  ;;PCC Data Entry Module
  1.  ;;
  1.  ;;************************************
  1.  ;;* GROUP PREVENTIVE FORM ENTER Mode *
  1.  ;;************************************
  1.  ;
  1.  ;
  1. REPRINT ;EP - called from option
  1.  D RXIT
  1.  ;IHS/CMI/LAB - patch 5 added this subroutine to re-print group forms
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option should be used to re-print group encounter forms.",!!,"You must know the group ID form number or the date of the group visit."
  1.  W !!,"Only group forms entered after PCC Data Entry Patch 5 was installed",!,"are available for re-printing.",!!
  1.  W !!,"Please enter the group ID form or the date of the visit.",!
  1.  D ^XBFMK
  1.  S DIC="^APCDGRP(",DIC(0)="AEMQ" D ^DIC
  1.  I Y=-1 W !!,"No form selected" H 2 D RXIT Q
  1.  S APCDFID=+Y
  1.  S X=0 F  S X=$O(^APCDGRP(APCDFID,11,X)) Q:X'=+X  S APCDEGP("FORMS",X)=""
  1.  I '$D(APCDEGP("FORMS")) W !!,"There are no visits to print.",! H 2 D RXIT Q
  1.  W !,"The following visit forms will be printed: "
  1.  S X=0 F  S X=$O(APCDEGP("FORMS",X)) Q:X'=+X  D
  1.  .W !?5,$$VAL^XBDIQ1(9000010,X,.01),?30,$$VAL^XBDIQ1(9000010,X,.05),?65,$$CLINIC^APCLV(X,"E")
  1.  D PRINT
  1.  D ^%ZISC
  1.  D RXIT
  1.  Q
  1. RXIT ;
  1.  D EN^XBVK("APCD")
  1.  D ^XBFMK
  1.  D KILL^AUPNPAT
  1.  Q