APCDOPOV ; IHS/CMI/LAB - CPV MNEMONIC CALLS
;;2.0;IHS PCC SUITE;**18**;MAY 14, 2009;Build 2
;
FMLK ;EP - called from input templates
;APCD CPV (ADD)
D EN^XBNEW("FMLK1^APCDOPOV","APCDDATE;APCDVSIT;AUPNSEX;APCDTSKI;APCDLOOK;APCDTERR;APCDUINP;APCDTNQP")
Q
FMLK1 ;EP - called from xbnew
K APCDTSKI,APCDTERR,APCDTNQP
K DIR
S DIR(0)="FO^1:60",DIR("A")="Enter PURPOSE OF VISIT"
S DIR("?")=$S($G(APCDTIN9):"^D HELP9^AUPNSIC9",1:"^D HELP^AUPNSICH")
S DIR("??")=$S($G(APCDTIN9):"^D HELP9^AUPNSIC9",1:"^D HELP^AUPNSICH")
KILL DA D ^DIR KILL DIR
I Y="" S APCDTSKI=1,APCDLOOK="" G XITL
I $D(DIRUT) S APCDLOOK="",APCDTSKI=1 G XITL
S APCDUINP=Y
S X=APCDUINP
X:$D(^DD(9000010.07,.01,12.1)) ^DD(9000010.07,.01,12.1) S DIC="^ICD9(",DIC(0)="EMQ" D ^DIC K DIC
G:Y="" XITL
;I $P(Y,U)=-1,X=""!(X="^") S APCDTSKI=1,APCDLOOK="" G XIT
I $P(Y,U)=-1 S APCDTERR=1,APCDLOOK="" G XITL
S APCDLOOK="`"_+Y,APCDTNQP=APCDUINP
N ;
;
XITL K Y,X,DO,D,DD,DIPGM,APCDTPCC
Q
EDIT01 ;EP - called from APCD CPV (MOD)
D EN^XBNEW("EDIT011^APCDOPOV","APCDTDA;APCDVSIT;APCDPAT;APCDDATE;DFN;AUPNPAT;AUPNVSIT;APCDTTMP")
Q
EDIT011 ;
K DIE,DA,DR
S APCDOVRR=1
;
S APCDT90=$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCDTDA,0),U,1),$$VD^APCLV(APCDVSIT)),U,20)
;PROVIDER NARRATIVE
D K
I $P($G(^AUPNVPOV(APCDTDA,11)),U,1)]"" D G 4
.W !!?5,"PROVIDER NARRATIVE: ",$$VAL^XBDIQ1(9000010.07,APCDTDA,.04),!! ;display only if snomed coded
I $G(APCDTTMP)="IPV" D G 4
.S APCDTNQ=$E($P($$ICDDX^ICDEX($P(^AUPNVPOV(APCDTDA,0),U,1),APCDD,,,"I"),U,4),1,140)_" ****ICD****"
.S DA=APCDTDA,DIE="^AUPNVPOV(",DR=".04///"_APCDTNQ,DIE("NO^")=1 D ^DIE K DIE,DA,DR
.W !!,"PROVIDER NARRATIVE: ",$$VAL^XBDIQ1(9000010.07,APCDTDA,.04)
NA ;
K DIR S DIR(0)="9000010.07,.04",DIR("A")="PROVIDER NARRATIVE",DIR("B")=$$VAL^XBDIQ1(9000010.07,APCDTDA,.04) KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q ;^
I X["|" D EN^DDIOL("A vertical bar '|' is not allowed in the provider narrative") G NA
S APCDTNQ=+Y
S DA=APCDTDA,DIE="^AUPNVPOV(",DR=".04////"_APCDTNQ D ^DIE K DIE,DA,DR
;
4 ;PRESENT ON ADMISSION/PRIMARY/SECONDAY H VISITS ONLY
D K
S APCDTIMH=""
S DIE="^AUPNVPOV(",DA=APCDTDA,DR="[APCD EDIT POV]" D ^DIE K DIE,DA,DR
I '$G(APCDTIMH) Q
17 ;
S DA=APCDTDA,DIE="^AUPNVPOV(",DR="[APCD EDIT CPV]" D ^DIE K DIE,DA,DR
Q
K ;
K DIE,DA,DR,DIR
K APCDTDEL,APCDTNPV,APCDTFIE,APCDTDIA,APCDIMP,APCDTIN9,APCDTUPH
Q
APCDOPOV ; IHS/CMI/LAB - CPV MNEMONIC CALLS
+1 ;;2.0;IHS PCC SUITE;**18**;MAY 14, 2009;Build 2
+2 ;
FMLK ;EP - called from input templates
+1 ;APCD CPV (ADD)
+2 DO EN^XBNEW("FMLK1^APCDOPOV","APCDDATE;APCDVSIT;AUPNSEX;APCDTSKI;APCDLOOK;APCDTERR;APCDUINP;APCDTNQP")
+3 QUIT
FMLK1 ;EP - called from xbnew
+1 KILL APCDTSKI,APCDTERR,APCDTNQP
+2 KILL DIR
+3 SET DIR(0)="FO^1:60"
SET DIR("A")="Enter PURPOSE OF VISIT"
+4 SET DIR("?")=$SELECT($GET(APCDTIN9):"^D HELP9^AUPNSIC9",1:"^D HELP^AUPNSICH")
+5 SET DIR("??")=$SELECT($GET(APCDTIN9):"^D HELP9^AUPNSIC9",1:"^D HELP^AUPNSICH")
+6 KILL DA
DO ^DIR
KILL DIR
+7 IF Y=""
SET APCDTSKI=1
SET APCDLOOK=""
GOTO XITL
+8 IF $DATA(DIRUT)
SET APCDLOOK=""
SET APCDTSKI=1
GOTO XITL
+9 SET APCDUINP=Y
+10 SET X=APCDUINP
+11 IF $DATA(^DD(9000010.07,.01,12.1))
XECUTE ^DD(9000010.07,.01,12.1)
SET DIC="^ICD9("
SET DIC(0)="EMQ"
DO ^DIC
KILL DIC
+12 IF Y=""
GOTO XITL
+13 ;I $P(Y,U)=-1,X=""!(X="^") S APCDTSKI=1,APCDLOOK="" G XIT
+14 IF $PIECE(Y,U)=-1
SET APCDTERR=1
SET APCDLOOK=""
GOTO XITL
+15 SET APCDLOOK="`"_+Y
SET APCDTNQP=APCDUINP
N ;
+1 ;
XITL KILL Y,X,DO,D,DD,DIPGM,APCDTPCC
+1 QUIT
EDIT01 ;EP - called from APCD CPV (MOD)
+1 DO EN^XBNEW("EDIT011^APCDOPOV","APCDTDA;APCDVSIT;APCDPAT;APCDDATE;DFN;AUPNPAT;AUPNVSIT;APCDTTMP")
+2 QUIT
EDIT011 ;
+1 KILL DIE,DA,DR
+2 SET APCDOVRR=1
+3 ;
+4 SET APCDT90=$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCDTDA,0),U,1),$$VD^APCLV(APCDVSIT)),U,20)
+5 ;PROVIDER NARRATIVE
+6 DO K
+7 IF $PIECE($GET(^AUPNVPOV(APCDTDA,11)),U,1)]""
Begin DoDot:1
+8 ;display only if snomed coded
WRITE !!?5,"PROVIDER NARRATIVE: ",$$VAL^XBDIQ1(9000010.07,APCDTDA,.04),!!
End DoDot:1
GOTO 4
+9 IF $GET(APCDTTMP)="IPV"
Begin DoDot:1
+10 SET APCDTNQ=$EXTRACT($PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCDTDA,0),U,1),APCDD,,,"I"),U,4),1,140)_" ****ICD****"
+11 SET DA=APCDTDA
SET DIE="^AUPNVPOV("
SET DR=".04///"_APCDTNQ
SET DIE("NO^")=1
DO ^DIE
KILL DIE,DA,DR
+12 WRITE !!,"PROVIDER NARRATIVE: ",$$VAL^XBDIQ1(9000010.07,APCDTDA,.04)
End DoDot:1
GOTO 4
NA ;
+1 KILL DIR
SET DIR(0)="9000010.07,.04"
SET DIR("A")="PROVIDER NARRATIVE"
SET DIR("B")=$$VAL^XBDIQ1(9000010.07,APCDTDA,.04)
KILL DA
DO ^DIR
KILL DIR
+2 ;^
IF $DATA(DIRUT)
QUIT
+3 IF X["|"
DO EN^DDIOL("A vertical bar '|' is not allowed in the provider narrative")
GOTO NA
+4 SET APCDTNQ=+Y
+5 SET DA=APCDTDA
SET DIE="^AUPNVPOV("
SET DR=".04////"_APCDTNQ
DO ^DIE
KILL DIE,DA,DR
+6 ;
4 ;PRESENT ON ADMISSION/PRIMARY/SECONDAY H VISITS ONLY
+1 DO K
+2 SET APCDTIMH=""
+3 SET DIE="^AUPNVPOV("
SET DA=APCDTDA
SET DR="[APCD EDIT POV]"
DO ^DIE
KILL DIE,DA,DR
+4 IF '$GET(APCDTIMH)
QUIT
17 ;
+1 SET DA=APCDTDA
SET DIE="^AUPNVPOV("
SET DR="[APCD EDIT CPV]"
DO ^DIE
KILL DIE,DA,DR
+2 QUIT
K ;
+1 KILL DIE,DA,DR,DIR
+2 KILL APCDTDEL,APCDTNPV,APCDTFIE,APCDTDIA,APCDIMP,APCDTIN9,APCDTUPH
+3 QUIT
