APCDEHI2 ; IHS/CMI/LAB - HISTORICAL HOSPITALIZATION CONT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009;Build 18
; Generate VISIT, then process MNEMONICS/TEMPLATE
;
START ;
S APCDX=""
I $D(APCDLPAT),APCDLPAT=APCDPAT,$D(APCDLDAT),APCDLDAT=APCDDATE,$D(APCDLVST),'APCDTPLT D SAMEPAT
S APCDLPAT=APCDPAT
S APCDLDAT=APCDDATE
I APCDX=1 D MNEPROC Q
Q:APCDX=2
K APCDLVST,APCDCLN,ZTSK
I $D(APCDTVST) S APCDTYPE=APCDTTYP,APCDCAT=APCDTCAT,APCDLOC=APCDTLOC K APCDTVST,APCDTTYP,APCDTCAT,APCDTLOC
S APCDNOXV="" D ^APCDALV K APCDNOXV
I $D(APCDAFLG)#2,APCDAFLG=2 W $C(7),!,"VISIT date not valid for current patient!",! S APCDFLG=1 Q
Q:APCDVSIT=""
S APCDLVST=APCDVSIT
S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE
S DA=APCDVSIT,DIE="^AUPNVSIT(",DR=".14////"_DT D ^DIE K DIE,DR,DA,DIU,DIV,^AUPNVSIT("APCIS",DT,APCDVSIT)
;S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT D ^DIE K DR,DA,DIE
S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X
K DR S APCDVDSP=APCDVSIT D ^APCDVDSP
F X="IP","PRV","PV" W !! D GET1
D MNEPROC
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 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",APCDVSIT=APCDLVST,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,APCDX,APCDEQX
Q
;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
Q:$D(APCDMOD)
S APCDMPQ=1
I $P(^AUPNVSIT(APCDVSIT,0),U,7)="E" Q
;K APCDNOCL D ^APCDVCHK
I APCDMODE'="M",'$D(^AUPNVPOV("AD",APCDVSIT)) W !,"PV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q
I APCDMODE'="M",'$D(^AUPNVPRV("AD",APCDVSIT)) W !,"PRV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q
D DEDT^APCDEA2(APCDVSIT) I $P(APCDPARM,U,5)="Y",'$D(^APCDFORM("AB",APCDVSIT)) S APCDFV=APCDVSIT D ^APCDFORM K APCDFV
Q
;
GET1 ;
W !!
S DIC="^APCDTKW(",DIC(0)="EMQX" D ^DIC K DIC
I Y<0 W !!,$C(7),$C(7),X," Mnemonic is Missing - Notify your Supervisor!" K DIC,X Q
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
D ^APCDEA3
Q
;
SAMEPAT ; SAME PATIENT
K DIR,DIRUT,DIROUT
S APCDX=+^AUPNVSIT(APCDLVST,0),APCDX=$E(APCDX,4,5)_"-"_$E(APCDX,6,7)_"-"_(1700+$E(APCDX,1,3))_$S($P(APCDX,".",2)]"":"@"_$P(APCDX,".",2),1:"")
W !!,"You have reselected the same patient.",!
W !,"Last VISIT is ",APCDX,!
S DIR("A")="Choose",DIR(0)="S^1:Modify last VISIT;2:Append to last VISIT;3:Create new VISIT;4:Quit"
D ^DIR
S APCDX=+Y
I $D(DIRUT) S APCDX=4
K DIR,DIRUT,DIROUT,DUOUT,DTOUT
D @("SAMEPAT"_APCDX)
Q
SAMEPAT1 ;
W " Switching to Modify Mode."
S APCDMODE="M",APCDVSIT=APCDLVST,APCDVLK=APCDVSIT D MNEPROC S APCDMODE="A",APCDX=2 K APCDVLK
W !!,"Returning to Enter Mode.",!
Q
SAMEPAT2 ;
W " Switching to Append Mode."
S APCDVSIT=APCDLVST,APCDX=1,APCDAPP=1
Q
SAMEPAT3 ;
W " Creating new VISIT, still in Add Mode."
S APCDX=3,APCDADD=1
Q
SAMEPAT4 ;
W " Quit",!
S APCDX=2
Q
APCDEHI2 ; IHS/CMI/LAB - HISTORICAL HOSPITALIZATION CONT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009;Build 18
+2 ; Generate VISIT, then process MNEMONICS/TEMPLATE
+3 ;
START ;
+1 SET APCDX=""
+2 IF $DATA(APCDLPAT)
IF APCDLPAT=APCDPAT
IF $DATA(APCDLDAT)
IF APCDLDAT=APCDDATE
IF $DATA(APCDLVST)
IF 'APCDTPLT
DO SAMEPAT
+3 SET APCDLPAT=APCDPAT
+4 SET APCDLDAT=APCDDATE
+5 IF APCDX=1
DO MNEPROC
QUIT
+6 IF APCDX=2
QUIT
+7 KILL APCDLVST,APCDCLN,ZTSK
+8 IF $DATA(APCDTVST)
SET APCDTYPE=APCDTTYP
SET APCDCAT=APCDTCAT
SET APCDLOC=APCDTLOC
KILL APCDTVST,APCDTTYP,APCDTCAT,APCDTLOC
+9 SET APCDNOXV=""
DO ^APCDALV
KILL APCDNOXV
+10 IF $DATA(APCDAFLG)#2
IF APCDAFLG=2
WRITE $CHAR(7),!,"VISIT date not valid for current patient!",!
SET APCDFLG=1
QUIT
+11 IF APCDVSIT=""
QUIT
+12 SET APCDLVST=APCDVSIT
+13 SET DIE="^AUPNPAT("
SET DR=".16///TODAY"
SET DA=APCDPAT
DO ^DIE
+14 SET DA=APCDVSIT
SET DIE="^AUPNVSIT("
SET DR=".14////"_DT
DO ^DIE
KILL DIE,DR,DA,DIU,DIV,^AUPNVSIT("APCIS",DT,APCDVSIT)
+15 ;S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT D ^DIE K DR,DA,DIE
+16 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+17 IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+18 KILL DR
SET APCDVDSP=APCDVSIT
DO ^APCDVDSP
+19 FOR X="IP","PRV","PV"
WRITE !!
DO GET1
+20 DO MNEPROC
+21 QUIT
+22 ;
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
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 APCDVSIT=APCDLVST
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,APCDX,APCDEQX
+2 QUIT
+3 ;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
+1 IF $DATA(APCDMOD)
QUIT
+2 SET APCDMPQ=1
+3 IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,7)="E"
QUIT
+4 ;K APCDNOCL D ^APCDVCHK
+5 IF APCDMODE'="M"
IF '$DATA(^AUPNVPOV("AD",APCDVSIT))
WRITE !,"PV mnemonic required!",!,APCDBEEP
IF '$DATA(DTOUT)
SET APCDMPQ=0
QUIT
+6 IF APCDMODE'="M"
IF '$DATA(^AUPNVPRV("AD",APCDVSIT))
WRITE !,"PRV mnemonic required!",!,APCDBEEP
IF '$DATA(DTOUT)
SET APCDMPQ=0
QUIT
+7 DO DEDT^APCDEA2(APCDVSIT)
IF $PIECE(APCDPARM,U,5)="Y"
IF '$DATA(^APCDFORM("AB",APCDVSIT))
SET APCDFV=APCDVSIT
DO ^APCDFORM
KILL APCDFV
+8 QUIT
+9 ;
GET1 ;
+1 WRITE !!
+2 SET DIC="^APCDTKW("
SET DIC(0)="EMQX"
DO ^DIC
KILL DIC
+3 IF Y<0
WRITE !!,$CHAR(7),$CHAR(7),X," Mnemonic is Missing - Notify your Supervisor!"
KILL DIC,X
QUIT
+4 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+5 DO ^APCDEA3
+6 QUIT
+7 ;
SAMEPAT ; SAME PATIENT
+1 KILL DIR,DIRUT,DIROUT
+2 SET APCDX=+^AUPNVSIT(APCDLVST,0)
SET APCDX=$EXTRACT(APCDX,4,5)_"-"_$EXTRACT(APCDX,6,7)_"-"_(1700+$EXTRACT(APCDX,1,3))_$SELECT($PIECE(APCDX,".",2)]"":"@"_$PIECE(APCDX,".",2),1:"")
+3 WRITE !!,"You have reselected the same patient.",!
+4 WRITE !,"Last VISIT is ",APCDX,!
+5 SET DIR("A")="Choose"
SET DIR(0)="S^1:Modify last VISIT;2:Append to last VISIT;3:Create new VISIT;4:Quit"
+6 DO ^DIR
+7 SET APCDX=+Y
+8 IF $DATA(DIRUT)
SET APCDX=4
+9 KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT
+10 DO @("SAMEPAT"_APCDX)
+11 QUIT
SAMEPAT1 ;
+1 WRITE " Switching to Modify Mode."
+2 SET APCDMODE="M"
SET APCDVSIT=APCDLVST
SET APCDVLK=APCDVSIT
DO MNEPROC
SET APCDMODE="A"
SET APCDX=2
KILL APCDVLK
+3 WRITE !!,"Returning to Enter Mode.",!
+4 QUIT
SAMEPAT2 ;
+1 WRITE " Switching to Append Mode."
+2 SET APCDVSIT=APCDLVST
SET APCDX=1
SET APCDAPP=1
+3 QUIT
SAMEPAT3 ;
+1 WRITE " Creating new VISIT, still in Add Mode."
+2 SET APCDX=3
SET APCDADD=1
+3 QUIT
SAMEPAT4 ;
+1 WRITE " Quit",!
+2 SET APCDX=2
+3 QUIT
