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
