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