- APCDPE1 ; IHS/CMI/LAB - DATA ENTRY ENTER MODE ;
- ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
- ;PATCH 2 commented out writing of date
- ;
- ; APCDFLG=0 ... RUN
- ; APCDFLG=1 ... ERROR
- ;
- ; APCDMODE=A ... ADD
- ; APCDMODE=M ... MOD
- ;
- HDR ; Write Header
- W:$D(IOF) @IOF
- W !!
- W "The following PCC Data Items will be prompted for for each visit created:"
- S X=0 F S X=$O(APCDCSEL(X)) Q:X'=+X W !?10,$P(^APCDTKW(APCDCSEL(X),0),U),?16,$S($P(^APCDTKW(APCDCSEL(X),0),U,12)]"":$P(^APCDTKW(APCDCSEL(X),0),U,12),1:$P(^APCDTKW(APCDCSEL(X),0),U,6))
- D ^APCDEIN
- Q:APCDFLG
- GETLOC ; GET LOCATION OF ENCOUNTER
- W !!
- S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)
- S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
- G:Y<0 EOJ
- S APCDLOC=+Y
- ;
- GETTYPE ; GET TYPE OF ENCOUNTER
- S APCDTYPE=""
- K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
- I $D(APCDDEFT),APCDDEFT]"" S DIR("B")=APCDDEFT
- S DIR(0)="9000010,.03O",DIR("A")="TYPE" D ^DIR K DIR
- I $D(DIRUT) S X="" G GETLOC
- S APCDTYPE=Y
- ;
- GETCAT ; GET SERVICE CATEGORY
- S APCDCAT=""
- K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
- I $D(APCDDEFS),APCDDEFS]"" S DIR("B")=APCDDEFS
- S DIR(0)="9000010,.07O",DIR("A")="SERVICE CATEGORY" D ^DIR K DIR
- I $D(DIRUT) S X="" G GETTYPE
- S APCDCAT=Y
- ;
- I APCDCAT'="A" G PROC1
- ;
- GETCLIN ;
- S APCDPECL=""
- K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA,DIC
- I $D(APCDDEFC),APCDDEFC]"" S DIC("B")=$P(^DIC(40.7,APCDDEFC,0),U)
- S DIC=40.7,DIC(0)="AEMQ",DIC("A")="Enter CLINIC: " D ^DIC K DIC
- I Y<0 G GETCAT
- S APCDPECL=+Y
- PROC1 ;********* loop through patients
- ;get template or individual patient names
- S APCDPEPP=""
- S DIR(0)="SO^C:Enter a COHORT (template) of Patient Names;I:Be prompted for Individual Patient Names",DIR("A")="Would you like to",DIR("B")="I" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) G EOJ
- I Y="C" D G EOJ
- .D GETTEMP G:APCDTEMP="" EOJ S APCDPEX=0 F S APCDPEX=$O(^DIBT(APCDTEMP,1,APCDPEX)) Q:APCDPEX="" S APCDPAT=APCDPEX D
- ..D INAC^APCDEA(APCDPAT,.X)
- ..I 'X S APCDPAT="" Q
- ..D PROCESS
- .Q
- S APCDPAT="" F D GETPAT Q:APCDPAT="" D PROCESS
- D EOJ
- 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
- K APCDODAT
- S APCDDATE=X
- GETTIME ;
- S APCDTIME=""
- I APCDTYPE="C"!("CNT"[APCDCAT) 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="" Q
- 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
- GETPAT ; GET PATIENT
- D GETPAT^APCDEA
- Q
- ;
- PROCESS ; PROCESS PATIENT
- W:$D(IOF) @IOF W !!,"Generating PCC Visit for ",$P(^DPT(APCDPAT,0),U)," DOB: ",$$FMTE^XLFDT($P(^DPT(APCDPAT,0),U,3)),!!
- D GETDATE
- I APCDDATE="" Q
- D ^APCDPE2
- Q
- ;
- GETTEMP ;
- ;
- W ! S DIC("S")="I $P(^(0),U,4)=9000001!($P(^(0),U,4)=2)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
- I Y=-1 S APCDTEMP="" Q
- S APCDTEMP=+Y
- Q
- EOJ ; END OF JOB
- D ^APCDEKL
- Q
- APCDPE1 ; IHS/CMI/LAB - DATA ENTRY ENTER MODE ;
- +1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
- +2 ;PATCH 2 commented out writing of date
- +3 ;
- +4 ; APCDFLG=0 ... RUN
- +5 ; APCDFLG=1 ... ERROR
- +6 ;
- +7 ; APCDMODE=A ... ADD
- +8 ; APCDMODE=M ... MOD
- +9 ;
- HDR ; Write Header
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !!
- +3 WRITE "The following PCC Data Items will be prompted for for each visit created:"
- +4 SET X=0
- FOR
- SET X=$ORDER(APCDCSEL(X))
- IF X'=+X
- QUIT
- WRITE !?10,$PIECE(^APCDTKW(APCDCSEL(X),0),U),?16,$SELECT($PIECE(^APCDTKW(APCDCSEL(X),0),U,12)]"":$PIECE(^APCDTKW(APCDCSEL(X),0),U,12),1:$PIECE(^APCDTKW(APCDCSEL(X),0),U,6))
- +5 DO ^APCDEIN
- +6 IF APCDFLG
- QUIT
- GETLOC ; GET LOCATION OF ENCOUNTER
- +1 WRITE !!
- +2 SET APCDLOC=""
- IF $DATA(APCDDEFL)
- IF APCDDEFL]""
- SET DIC("B")=$PIECE(^DIC(4,APCDDEFL,0),U)
- +3 SET DIC="^AUTTLOC("
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC
- +4 IF Y<0
- GOTO EOJ
- +5 SET APCDLOC=+Y
- +6 ;
- GETTYPE ; GET TYPE OF ENCOUNTER
- +1 SET APCDTYPE=""
- +2 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
- +3 IF $DATA(APCDDEFT)
- IF APCDDEFT]""
- SET DIR("B")=APCDDEFT
- +4 SET DIR(0)="9000010,.03O"
- SET DIR("A")="TYPE"
- DO ^DIR
- KILL DIR
- +5 IF $DATA(DIRUT)
- SET X=""
- GOTO GETLOC
- +6 SET APCDTYPE=Y
- +7 ;
- GETCAT ; GET SERVICE CATEGORY
- +1 SET APCDCAT=""
- +2 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
- +3 IF $DATA(APCDDEFS)
- IF APCDDEFS]""
- SET DIR("B")=APCDDEFS
- +4 SET DIR(0)="9000010,.07O"
- SET DIR("A")="SERVICE CATEGORY"
- DO ^DIR
- KILL DIR
- +5 IF $DATA(DIRUT)
- SET X=""
- GOTO GETTYPE
- +6 SET APCDCAT=Y
- +7 ;
- +8 IF APCDCAT'="A"
- GOTO PROC1
- +9 ;
- GETCLIN ;
- +1 SET APCDPECL=""
- +2 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA,DIC
- +3 IF $DATA(APCDDEFC)
- IF APCDDEFC]""
- SET DIC("B")=$PIECE(^DIC(40.7,APCDDEFC,0),U)
- +4 SET DIC=40.7
- SET DIC(0)="AEMQ"
- SET DIC("A")="Enter CLINIC: "
- DO ^DIC
- KILL DIC
- +5 IF Y<0
- GOTO GETCAT
- +6 SET APCDPECL=+Y
- PROC1 ;********* loop through patients
- +1 ;get template or individual patient names
- +2 SET APCDPEPP=""
- +3 SET DIR(0)="SO^C:Enter a COHORT (template) of Patient Names;I:Be prompted for Individual Patient Names"
- SET DIR("A")="Would you like to"
- SET DIR("B")="I"
- KILL DA
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- GOTO EOJ
- +5 IF Y="C"
- Begin DoDot:1
- +6 DO GETTEMP
- IF APCDTEMP=""
- GOTO EOJ
- SET APCDPEX=0
- FOR
- SET APCDPEX=$ORDER(^DIBT(APCDTEMP,1,APCDPEX))
- IF APCDPEX=""
- QUIT
- SET APCDPAT=APCDPEX
- Begin DoDot:2
- +7 DO INAC^APCDEA(APCDPAT,.X)
- +8 IF 'X
- SET APCDPAT=""
- QUIT
- +9 DO PROCESS
- End DoDot:2
- +10 QUIT
- End DoDot:1
- GOTO EOJ
- +11 SET APCDPAT=""
- FOR
- DO GETPAT
- IF APCDPAT=""
- QUIT
- DO PROCESS
- +12 DO EOJ
- +13 QUIT
- 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 KILL APCDODAT
- +7 SET APCDDATE=X
- GETTIME ;
- +1 SET APCDTIME=""
- +2 IF APCDTYPE="C"!("CNT"[APCDCAT)
- SET APCDTIME="12:00"
- +3 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
- +4 SET APCDTIME=""
- +5 IF X="^"
- SET APCDDATE=""
- QUIT
- +6 IF X=""
- WRITE APCDBEEP," Time Required!"
- GOTO GETTIME
- +7 IF X["?"
- WRITE !,"Enter time of visit, or 'D' for default."
- GOTO GETTIME
- +8 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
- GETPAT ; GET PATIENT
- +1 DO GETPAT^APCDEA
- +2 QUIT
- +3 ;
- PROCESS ; PROCESS PATIENT
- +1 IF $DATA(IOF)
- WRITE @IOF
- WRITE !!,"Generating PCC Visit for ",$PIECE(^DPT(APCDPAT,0),U)," DOB: ",$$FMTE^XLFDT($PIECE(^DPT(APCDPAT,0),U,3)),!!
- +2 DO GETDATE
- +3 IF APCDDATE=""
- QUIT
- +4 DO ^APCDPE2
- +5 QUIT
- +6 ;
- GETTEMP ;
- +1 ;
- +2 WRITE !
- SET DIC("S")="I $P(^(0),U,4)=9000001!($P(^(0),U,4)=2)"
- SET DIC="^DIBT("
- SET DIC("A")="Enter Patient SEARCH TEMPLATE name: "
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC,DA,DR,DICR
- +3 IF Y=-1
- SET APCDTEMP=""
- QUIT
- +4 SET APCDTEMP=+Y
- +5 QUIT
- EOJ ; END OF JOB
- +1 DO ^APCDEKL
- +2 QUIT