APCDEGP1.m

APCDEGP1 ; IHS/CMI/LAB - GROUP FORM DATA ENTRY ;

 ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18

 ;

START ;

 W !

 K APCDALVR

 D EDITCHKS^APCDEGP2

 I $D(APCDEFLG) D XIT1 Q

 D GENVISIT

 I $G(APCDVSIT)="" D XIT1 Q

 S APCDEGP("VISIT")=APCDVSIT

 D GENPOV

 D GENPRV

 D GENEDUC

 S APCDVDSP=APCDVSIT D ^APCDEWHA K APCDVDSP

 K AUPNTALK,APCDALVR

 D MNEPROC

XIT ;

 ;set visit in the group file for formid ien

 S APCDEGP("FORMS",APCDEGP("VISIT"))=""

 ;call file^dicn to add to multiple of group file

 D ^XBFMK K DIADD,DLAYGO

 S DIC="^APCDGRP("_APCDFID_",11,",DIC(0)="L",DIC("P")=$P(^DD(9001002.3,11,0),U,2),DA(1)=APCDFID,X="`"_APCDEGP("VISIT") D ^DIC

 I Y=-1 W !!,"adding visit to group file entry failed.  Notify supervisor." H 2

 D ^XBFMK K DIADD,DLAYGO

XIT1 K APCDEG1,APCDEG2,APCDEGPR,APCDEGY,APCDTACC,APCDEGX,Y,APCDALVR,APCDEGP("VISIT")

 Q

GENVISIT ;

 S APCDALVR("APCDLOC")=APCDLOC

 S APCDALVR("APCDCAT")=APCDCAT

 S APCDALVR("APCDTYPE")=APCDTYPE

 S APCDALVR("APCDPAT")=APCDPAT

 S APCDALVR("APCDDATE")=APCDDATE

 S APCDALVR("APCDCLN")=APCDCLIN

 ;

 W !,"Creating PCC Visit",!

 S APCDALVR("APCDNOK")=""

 S APCDALVR("APCDPAT")=APCDPAT

 S APCDNOXV="" D ^APCDALV K APCDNOXV

 I $D(APCDALVR("APCDAFLG")),APCDALVR("APCDAFLG")=1 W !,$C(7),"No Visit Selected",! K APCDALVR("APCDAFLG"),APCDVSIT Q

 I $D(APCDALVR("APCDAFLG")),APCDALVR("APCDAFLG")=2 W !,$C(7),"Error encountered when creating visit!," K APCDALVR("APCDAFLG"),APCDVSIT Q

 ;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")'<$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR

 ;above added for EHR and auditing of visits, d/e created

 Q

GENPOV ;

 W !,"Creating POV Record"

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"

 K APCDEGPR S (APCDEG1,APCDEG2)=0,APCDEGPR="" F  S APCDEG2=$O(^AUPNVPOV("AD",APCDVSIT,APCDEG2)) Q:APCDEG2=""  S APCDEGPR($P(^AUPNVPOV(APCDEG2,0),U))=""

 D POV

 Q

POV ;

 S APCDEGX=0 F  S APCDEGX=$O(^TMP("APCDEGP",$J,"POV",APCDEGX)) Q:APCDEGX=""  D SETPOV

 Q

SETPOV ;

 K APCDALVR("APCDTACC"),APCDALVR("APCDAFLG")

 Q:$D(APCDEGPR($P($P(^TMP("APCDEGP",$J,"POV",APCDEGX,"APCDTPOV"),U),"`",2)))  ;skip if already there

 S APCDALVR("APCDTPOV")=$P(^TMP("APCDEGP",$J,"POV",APCDEGX,"APCDTPOV"),U),APCDALVR("APCDTNQ")=$P(^("APCDTPOV"),U,2),APCDALVR("APCDTFR")=$P(^("APCDTPOV"),U,3)

 S:$D(APCDTACC) APCDALVR("APCDTACC")=DUZ

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) D ERROR

 Q

 ;

GENPRV ;

 W !,"Creating Provider Record"

 K APCDEGPR S (APCDEG1,APCDEG2)=0,APCDEGPR="" F  S APCDEG2=$O(^AUPNVPRV("AD",APCDVSIT,APCDEG2)) Q:APCDEG2=""  S APCDEGPR($P(^AUPNVPRV(APCDEG2,0),U))=""

 D PROV

 Q

MNEPROC ; PROCESS MNEMONICS UNTIL DONE

 S APCDMPQ=0

 F  D GETMNE D:$D(APCDEQX) CHKEHR2^APCDVCHK I APCDMPQ Q

 D GETMNEK

 K APCDMPQ

 Q

 ;

GETMNE ; GET MNEMONIC

 W !

 S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^(0),U))<5" D ^DIC K DIC("A"),DIC("S")

 I Y<0 D CHECK^APCDEGP0 Q

 S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)

 K APCDMOD

 D ^APCDEA3

 I $D(APCDEQX) D ^APCDEQX I $D(APCDEQX) S APCDMPQ=1 Q

 I $D(APCDMOD) W !!,"Switching to Modify Mode for ONE Mnemonic ONLY!" S APCDMODE="M",APCDVLK=APCDVSIT D GETMNE K APCDVLK,APCDMOD S APCDMODE="A" W !!,"Switching back to ENTER Mode!" Q

 Q

 ;

GETMNEK ; KILL GETMNE SPECIFIC VARIABLES

 K APCDVSIT,APCDEGX,APCDEQX

 Q

PROV ;

 S APCDEGX=0,APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]" F  S APCDEGX=$O(^TMP("APCDEGP",$J,"PROV",APCDEGX)) Q:APCDEGX=""  D SETPROV

 Q

SETPROV ;

 Q:$D(APCDEGPR($P($P(^TMP("APCDEGP",$J,"PROV",APCDEGX,"APCDTPRV"),U),"`",2)))  ;skip if already there

 S APCDALVR("APCDTPRO")=$P(^TMP("APCDEGP",$J,"PROV",APCDEGX,"APCDTPRV"),U),APCDALVR("APCDTPS")=$P(^("APCDTPRV"),U,2)

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) D ERROR

 Q

ERROR ;

 I APCDALVR("APCDAFLG")=1 W !,$C(7),"Template Missing - Notify Site Manager",! Q

 I APCDALVR("APCDAFLG")=2 W !,$C(7),"Error in V File Creation!" Q

 Q

TSKMN ;for queueing when need to queue (call from setprov,setpov)

 K ZTSAVE F APCDEGY="APCDALVR(","DUZ(","DUZ","DT" S ZTSAVE(APCDEGY)=""

 S ZTRTN="ZTSK^APCDEGP2",ZTDESC="PCC GROUP FORM DATA ENTRY",ZTIO="",ZTDTH=DT D ^%ZTLOAD K ZTSK

 K ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE

 Q

GENEDUC ;

 W !,"Creating Patient Education Record"

 K APCDEGPR S (APCDEG1,APCDEG2)=0,APCDEGPR="" F  S APCDEG2=$O(^AUPNVPED("AD",APCDVSIT,APCDEG2)) Q:APCDEG2=""  S APCDEGPR($P(^AUPNVPED(APCDEG2,0),U))=""

 D EDUC

 Q

EDUC ;

 S APCDEGX=0 F  S APCDEGX=$O(^TMP("APCDEGP",$J,"EDUC",APCDEGX)) Q:APCDEGX=""  D SETEDUC

 Q

SETEDUC ;

 Q:$D(APCDEGPR($P($P(^TMP("APCDEGP",$J,"EDUC",APCDEGX,"APCDTTOP"),U),"`",2)))  ;skip if already there

 K APCDALVR

 S APCDALVR("APCDPAT")=APCDPAT

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.16 (ADD)]"

 S APCDALVR("APCDTTOP")=$P(^TMP("APCDEGP",$J,"EDUC",APCDEGX,"APCDTTOP"),U)

 I $P(^TMP("APCDEGP",$J,"EDUC",APCDEGX,"APCDTTOP"),U,3)]"" S APCDALVR("APCDTPRO")="`"_$P(^TMP("APCDEGP",$J,"EDUC",APCDEGX,"APCDTTOP"),U,3)

 S APCDALVR("APCDTLOU")=4

 S APCDALVR("APCDTIG")="G"

 S APCDALVR("APCDTMIN")=$P(^TMP("APCDEGP",$J,"EDUC",APCDEGX,"APCDTTOP"),U,2)

 I $P(^TMP("APCDEGP",$J,"EDUC",APCDEGX,"APCDTTOP"),U,4)]"" S APCDALVR("APCDTOBJ")=$P(^TMP("APCDEGP",$J,"EDUC",APCDEGX,"APCDTTOP"),U,4)

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) D ERROR

 Q

APCDEGP1  ; IHS/CMI/LAB - GROUP FORM DATA ENTRY ;

 +1       ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18

 +2       ;

START     ;

 +1        WRITE !

 +2        KILL APCDALVR

 +3        DO EDITCHKS^APCDEGP2

 +4        IF $DATA(APCDEFLG)

               DO XIT1

               QUIT 

 +5        DO GENVISIT

 +6        IF $GET(APCDVSIT)=""

               DO XIT1

               QUIT 

 +7        SET APCDEGP("VISIT")=APCDVSIT

 +8        DO GENPOV

 +9        DO GENPRV

 +10       DO GENEDUC

 +11       SET APCDVDSP=APCDVSIT

           DO ^APCDEWHA

           KILL APCDVDSP

 +12       KILL AUPNTALK,APCDALVR

 +13       DO MNEPROC

XIT       ;

 +1       ;set visit in the group file for formid ien

 +2        SET APCDEGP("FORMS",APCDEGP("VISIT"))=""

 +3       ;call file^dicn to add to multiple of group file

 +4        DO ^XBFMK

           KILL DIADD,DLAYGO

 +5        SET DIC="^APCDGRP("_APCDFID_",11,"

           SET DIC(0)="L"

           SET DIC("P")=$PIECE(^DD(9001002.3,11,0),U,2)

           SET DA(1)=APCDFID

           SET X="`"_APCDEGP("VISIT")

           DO ^DIC

 +6        IF Y=-1

               WRITE !!,"adding visit to group file entry failed.  Notify supervisor."

               HANG 2

 +7        DO ^XBFMK

           KILL DIADD,DLAYGO

XIT1       KILL APCDEG1,APCDEG2,APCDEGPR,APCDEGY,APCDTACC,APCDEGX,Y,APCDALVR,APCDEGP("VISIT")

 +1        QUIT 

GENVISIT  ;

 +1        SET APCDALVR("APCDLOC")=APCDLOC

 +2        SET APCDALVR("APCDCAT")=APCDCAT

 +3        SET APCDALVR("APCDTYPE")=APCDTYPE

 +4        SET APCDALVR("APCDPAT")=APCDPAT

 +5        SET APCDALVR("APCDDATE")=APCDDATE

 +6        SET APCDALVR("APCDCLN")=APCDCLIN

 +7       ;

 +8        WRITE !,"Creating PCC Visit",!

 +9        SET APCDALVR("APCDNOK")=""

 +10       SET APCDALVR("APCDPAT")=APCDPAT

 +11       SET APCDNOXV=""

           DO ^APCDALV

           KILL APCDNOXV

 +12       IF $DATA(APCDALVR("APCDAFLG"))

               IF APCDALVR("APCDAFLG")=1

                   WRITE !,$CHAR(7),"No Visit Selected",!

                   KILL APCDALVR("APCDAFLG"),APCDVSIT

                   QUIT 

 +13       IF $DATA(APCDALVR("APCDAFLG"))

               IF APCDALVR("APCDAFLG")=2

                   WRITE !,$CHAR(7),"Error encountered when creating visit!,"

                   KILL APCDALVR("APCDAFLG"),APCDVSIT

                   QUIT 

 +14      ;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")'<$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR

 +15      ;above added for EHR and auditing of visits, d/e created

 +16       QUIT 

GENPOV    ;

 +1        WRITE !,"Creating POV Record"

 +2        SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"

 +3        KILL APCDEGPR

           SET (APCDEG1,APCDEG2)=0

           SET APCDEGPR=""

           FOR 

               SET APCDEG2=$ORDER(^AUPNVPOV("AD",APCDVSIT,APCDEG2))

               IF APCDEG2=""

                   QUIT 

               SET APCDEGPR($PIECE(^AUPNVPOV(APCDEG2,0),U))=""

 +4        DO POV

 +5        QUIT 

POV       ;

 +1        SET APCDEGX=0

           FOR 

               SET APCDEGX=$ORDER(^TMP("APCDEGP",$JOB,"POV",APCDEGX))

               IF APCDEGX=""

                   QUIT 

               DO SETPOV

 +2        QUIT 

SETPOV    ;

 +1        KILL APCDALVR("APCDTACC"),APCDALVR("APCDAFLG")

 +2       ;skip if already there

           IF $DATA(APCDEGPR($PIECE($PIECE(^TMP("APCDEGP",$JOB,"POV",APCDEGX,"APCDTPOV"),U),"`",2)))

               QUIT 

 +3        SET APCDALVR("APCDTPOV")=$PIECE(^TMP("APCDEGP",$JOB,"POV",APCDEGX,"APCDTPOV"),U)

           SET APCDALVR("APCDTNQ")=$PIECE(^("APCDTPOV"),U,2)

           SET APCDALVR("APCDTFR")=$PIECE(^("APCDTPOV"),U,3)

 +4        IF $DATA(APCDTACC)

               SET APCDALVR("APCDTACC")=DUZ

 +5        DO ^APCDALVR

 +6        IF $DATA(APCDALVR("APCDAFLG"))

               DO ERROR

 +7        QUIT 

 +8       ;

GENPRV    ;

 +1        WRITE !,"Creating Provider Record"

 +2        KILL APCDEGPR

           SET (APCDEG1,APCDEG2)=0

           SET APCDEGPR=""

           FOR 

               SET APCDEG2=$ORDER(^AUPNVPRV("AD",APCDVSIT,APCDEG2))

               IF APCDEG2=""

                   QUIT 

               SET APCDEGPR($PIECE(^AUPNVPRV(APCDEG2,0),U))=""

 +3        DO PROV

 +4        QUIT 

MNEPROC   ; PROCESS MNEMONICS UNTIL DONE

 +1        SET APCDMPQ=0

 +2        FOR 

               DO GETMNE

               IF $DATA(APCDEQX)

                   DO CHKEHR2^APCDVCHK

               IF APCDMPQ

                   QUIT 

 +3        DO GETMNEK

 +4        KILL APCDMPQ

 +5        QUIT 

 +6       ;

GETMNE    ; GET MNEMONIC

 +1        WRITE !

 +2        SET DIC="^APCDTKW("

           SET DIC(0)="AEMQ"

           SET DIC("A")="MNEMONIC: "

           SET DIC("S")="I $L($P(^(0),U))<5"

           DO ^DIC

           KILL DIC("A"),DIC("S")

 +3        IF Y<0

               DO CHECK^APCDEGP0

               QUIT 

 +4        SET APCDMNE=+Y

           SET APCDMNE("NAME")=$PIECE(Y,U,2)

 +5        KILL APCDMOD

 +6        DO ^APCDEA3

 +7        IF $DATA(APCDEQX)

               DO ^APCDEQX

               IF $DATA(APCDEQX)

                   SET APCDMPQ=1

                   QUIT 

 +8        IF $DATA(APCDMOD)

               WRITE !!,"Switching to Modify Mode for ONE Mnemonic ONLY!"

               SET APCDMODE="M"

               SET APCDVLK=APCDVSIT

               DO GETMNE

               KILL APCDVLK,APCDMOD

               SET APCDMODE="A"

               WRITE !!,"Switching back to ENTER Mode!"

               QUIT 

 +9        QUIT 

 +10      ;

GETMNEK   ; KILL GETMNE SPECIFIC VARIABLES

 +1        KILL APCDVSIT,APCDEGX,APCDEQX

 +2        QUIT 

PROV      ;

 +1        SET APCDEGX=0

           SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"

           FOR 

               SET APCDEGX=$ORDER(^TMP("APCDEGP",$JOB,"PROV",APCDEGX))

               IF APCDEGX=""

                   QUIT 

               DO SETPROV

 +2        QUIT 

SETPROV   ;

 +1       ;skip if already there

           IF $DATA(APCDEGPR($PIECE($PIECE(^TMP("APCDEGP",$JOB,"PROV",APCDEGX,"APCDTPRV"),U),"`",2)))

               QUIT 

 +2        SET APCDALVR("APCDTPRO")=$PIECE(^TMP("APCDEGP",$JOB,"PROV",APCDEGX,"APCDTPRV"),U)

           SET APCDALVR("APCDTPS")=$PIECE(^("APCDTPRV"),U,2)

 +3        DO ^APCDALVR

 +4        IF $DATA(APCDALVR("APCDAFLG"))

               DO ERROR

 +5        QUIT 

ERROR     ;

 +1        IF APCDALVR("APCDAFLG")=1

               WRITE !,$CHAR(7),"Template Missing - Notify Site Manager",!

               QUIT 

 +2        IF APCDALVR("APCDAFLG")=2

               WRITE !,$CHAR(7),"Error in V File Creation!"

               QUIT 

 +3        QUIT 

TSKMN     ;for queueing when need to queue (call from setprov,setpov)

 +1        KILL ZTSAVE

           FOR APCDEGY="APCDALVR(","DUZ(","DUZ","DT"

               SET ZTSAVE(APCDEGY)=""

 +2        SET ZTRTN="ZTSK^APCDEGP2"

           SET ZTDESC="PCC GROUP FORM DATA ENTRY"

           SET ZTIO=""

           SET ZTDTH=DT

           DO ^%ZTLOAD

           KILL ZTSK

 +3        KILL ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE

 +4        QUIT 

GENEDUC   ;

 +1        WRITE !,"Creating Patient Education Record"

 +2        KILL APCDEGPR

           SET (APCDEG1,APCDEG2)=0

           SET APCDEGPR=""

           FOR 

               SET APCDEG2=$ORDER(^AUPNVPED("AD",APCDVSIT,APCDEG2))

               IF APCDEG2=""

                   QUIT 

               SET APCDEGPR($PIECE(^AUPNVPED(APCDEG2,0),U))=""

 +3        DO EDUC

 +4        QUIT 

EDUC      ;

 +1        SET APCDEGX=0

           FOR 

               SET APCDEGX=$ORDER(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX))

               IF APCDEGX=""

                   QUIT 

               DO SETEDUC

 +2        QUIT 

SETEDUC   ;

 +1       ;skip if already there

           IF $DATA(APCDEGPR($PIECE($PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX,"APCDTTOP"),U),"`",2)))

               QUIT 

 +2        KILL APCDALVR

 +3        SET APCDALVR("APCDPAT")=APCDPAT

 +4        SET APCDALVR("APCDVSIT")=APCDVSIT

 +5        SET APCDALVR("APCDATMP")="[APCDALVR 9000010.16 (ADD)]"

 +6        SET APCDALVR("APCDTTOP")=$PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX,"APCDTTOP"),U)

 +7        IF $PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX,"APCDTTOP"),U,3)]""

               SET APCDALVR("APCDTPRO")="`"_$PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX,"APCDTTOP"),U,3)

 +8        SET APCDALVR("APCDTLOU")=4

 +9        SET APCDALVR("APCDTIG")="G"

 +10       SET APCDALVR("APCDTMIN")=$PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX,"APCDTTOP"),U,2)

 +11       IF $PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX,"APCDTTOP"),U,4)]""

               SET APCDALVR("APCDTOBJ")=$PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGX,"APCDTTOP"),U,4)

 +12       DO ^APCDALVR

 +13       IF $DATA(APCDALVR("APCDAFLG"))

               DO ERROR

 +14       QUIT