- 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
