BDGPCCEL ; IHS/ANMC/LJF - CODE PCC VISIT LISTING ; [ 08/12/2002 10:14 AM ]
;;5.3;PIMS;**1005,1006,1010**;MAY 28, 2004
;IHS/OIT/LJF 03/16/2006 PATCH 1005 added HF & PED mnemonic choices
; drops into ADD mode if nothing to MODIFY
; 04/06/2006 patch 1005 added trigger to stuff date coded in NICE
; prevent ^DGPMEX from asking patient name again
; 07/07/2006 PATCH 1006 prevent error if no mnemonic is selected
;cmi/anch/maw 10/20/2008 PATCH 1010 changed date exported field from .14 to 1106
;
EN ; -- main entry point for BDG IC CODE
; Assumes DFN and BDGV are set
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG IC CODE")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X,Y,VH
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
;
S X=$$GET1^DIQ(2,DFN,.01)_$$SP(5)_"#"_$$HRCN^BDGF2(DFN,DUZ(2))
S VALMHDR(2)=$$SP(79-$L(X)\2)_X
;
S VH=$O(^AUPNVINP("AD",BDGV,0)) Q:'VH
S X=$$GET1^DIQ(9000010.02,VH,.15)
S Y="Coding Complete? "_$S(X="NO":"NO",1:"YES")
;S VALMHDR(3)=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,.14) ;cmi/maw 10/10/2008 PATCH 1010 orig line
S VALMHDR(3)=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,1106) ;cmi/maw 10/10/2008 PATCH 1010 new export date
Q
;
INIT ; -- init variables and list array
K ^TMP("BDGPCCE",$J)
S VALMCNT=0
D MSG^BDGF("Please wait while I gather all visit data...",2,0)
D ^BDGPCCE1 ;build display screens
Q
;
ADMIT ;EP; called by Admission Data protocol
D FULL^VALM1
;
I '$O(^DGPM("AVISIT",BDGV,0)) D Q
. D MSG^BDGF("Visit NOT linked to ADT Admission",2,0)
. D MSG^BDGF("Cannot continue. Please advise your supervisor.",1,0)
. D PAUSE^BDGF
;
NEW BDGVH
S BDGVH=$O(^AUPNVINP("AD",BDGV,0)) I 'BDGVH D Q
. D MSG^BDGF("No V Hospitalization linked with Visit!!!",2,0)
. D MSG^BDGF("Cannot continue. Please advise your supervisor.",1,0)
. D PAUSE^BDGF
;
; add/edit # of consults and admitting dx
L +^AUPNVINP(BDGVH):3 I '$T D Q
. D MSG^BDGF("Someone else is updating this hospitalization.",2,0)
. D MSG^BDGF("Please try again later.",1,0),PAUSE^BDGF
K DIE,DA,DR S DIE="^AUPNVINP(",DA=BDGVH,DR=".08;.12" D ^DIE,EDIT
L -^AUPNVINP(BDGVH)
;
; add/edit DRG
L +^AUPNVSIT(BDGV):3 I '$T D Q
. D MSG^BDGF("Someone else is updating this visit.",2,0)
. D MSG^BDGF("Please try again later.",1,0),PAUSE^BDGF
K DIE,DA,DR S DIE="^AUPNVSIT(",DA=BDGV,DR=".34" D ^DIE,EDIT
L -^AUPNVSIT(BDGV)
;
; call ADT to edit common fields
NEW DGPMCA,DGPMEX,DGPMAN,BDGDFN
S DGPMCA=$O(^DGPM("AVISIT",BDGV,0)),DGPMEX=""
S DGPMAN=$G(^DGPM(+DGPMCA,0)),BDGDFN=DFN
S ^DISV(DUZ,"DGPMEX",DFN)=DGPMCA
;
;IHS/OIT/LJF 04/06/2006 PATCH 1005 set BDGCODE to prevent asking patient name again
NEW BDGCODE S BDGCODE=1
;
D ENEX^DGPMV20,ASK^DGPMEX,EDIT ;call extended bed control
S (DFN,AUPNPAT)=BDGDFN D SETPT^BDGF(DFN) ;reset patient variables
;
D RESET
Q
;
ADD ;EP; called by Add/Modify PCC Data protocol
NEW APCDCAT,APCDVSIT,APCDPAT,APCDLOC,APCDTYPE,APCDMODE,APCDPARM
NEW APCDMNE,BDGMN,BDGA,Y,APCDVLDT,APCDVLK,BDGBL,DIC
S APCDCAT="H",(APCDVSIT,APCDVLK)=BDGV,APCDPAT=DFN
S APCDPARM=$G(^APCDSITE(DUZ(2),0))
S (APCDDATE,APCDVLDT)=$$GET1^DIQ(9000010,BDGV,.01,"I")
S APCDLOC=DUZ(2),APCDTYPE=$$GET1^DIQ(9000010,BDGV,.03,"I")
;
D FULL^VALM1,^APCDEIN
ASK ;
;IHS/OIT/LJF 03/16/2006 PATCH 1005 rewrote subrtn to handle HF and PED
K BDGA,APCDMNE W !!
S BDGA(1)=" (1) DIAGNOSIS (5) IMMUNIZATIONS"
S BDGA(2)=" (2) PROCEDURES (6) HEALTH FACTORS"
S BDGA(3)=" (3) PROVIDERS (7) PATIENT EDUCATION"
S BDGA(4)=" (4) ADMITTING DX (8) OTHER MNEMONICS"
S BDGMN=$$READ^BDGF("NO^1:8","Select One","","","",.BDGA)
I 'BDGMN D ENDADD Q
;
;IHS/OIT/LJF 07/07/2006 PATCH 1006 rewrote section
;I BDGMN=8 D Q
I BDGMN=8 D D ASK Q
. ;S Y=$$READ^BDGF("P^9001001:EMQZ","MNEMONIC")
. S Y=$$READ^BDGF("P^9001001:EMQZ","MNEMONIC") Q:Y<1
. S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
. S APCDMODE=$$READ^BDGF("SO^A:ADD;M:MODIFY","Select MODE")
. ;D ^APCDEA3,ASK
. D ^APCDEA3
;
E S DIC=9001001,DIC(0)="",X=$P($T(MNE+BDGMN),";;",2) D ^DIC
I Y<1 D ASK Q
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
S BDGBL=$P($T(MNE+BDGMN),";;",3) I (BDGMN'=8),(BDGBL="") S APCDMODE="M"
E D
. S Y=BDGBL_"(""AD"","_BDGV_",0)" I '$O(@Y) S APCDMODE="A" Q
. S APCDMODE=$$READ^BDGF("SO^A:ADD;M:MODIFY","Select MODE")
I (APCDMODE="")!(APCDMODE=U)
;
D ^APCDEA3,ASK Q
;
; when done with coding, mark visit as edited and return to display
ENDADD D EDIT,RESET
Q
;
LIST ;EP; Called by List I Visits protocol
D EN^BDGPCCE2 S VALMBCK="R" Q
;
PROB ;EP; Called by Problem List Update protocol
NEW VALMCNT
D EN1^APCDPL ;public entry point, assumes DFN is set
S VALMBCK="R"
Q
;
ALL ;EP; Called by Display All Data protocol (BDG IC PCC DISPLAY ALL)
; Also called by BDG VIEW PCC protocol
NEW APCDPAT,APCDVSIT
S APCDPAT=DFN,APCDVSIT=BDGV
D ^APCDVD ;public entry point
D EN^XBVK("APCD") S VALMBCK="R"
Q
;
FASH ;EP; Called by Final A Sheet protocol
NEW DGPMCA,BDGFIN
D FULL^VALM1
S DGPMCA=$O(^DGPM("AVISIT",BDGV,0))
S BDGFIN=$$READ^BDGF("SO^1:A Sheet Only;2:A Sheet with CPT List;3:Medicare/Medicaid A Sheet","Select Report to Print",$$GET1^DIQ(9009020.1,$$DIV^BSDU,.07,"I"),"^D FINHLP^BDGCRB")
I 'BDGFIN S VALMBCK="R" Q
D PAT^BDGCRB(DFN,DGPMCA,BDGFIN,1,2)
D PAUSE^BDGF S VALMBCK="R"
Q
;
RESET ;EP; return from protocol & rebuild list
S VALMBCK="R" D TERM^VALM0,HDR,INIT Q
;
EDIT ; update date last edited
NEW AUPNVSIT S AUPNVSIT=BDGV D MOD^AUPNVSIT Q
;
CHECK(DATE) ;EP; run inpatient edit check
; DATE=1 if check to be run only if updated today
; DATE=0 run check anyway
I DATE,$$GET1^DIQ(9000010,BDGV,.13,"I")'=DT Q
;
NEW BDGVH,X,Y
S BDGVH=$O(^AUPNVINP("AD",BDGV,0)) Q:'BDGVH
D FULL^VALM1
S X=$$GET1^DIQ(9000010.02,BDGVH,.15)
S Y="Coding Complete? "_$S(X="NO":"NO",1:"YES")
;S X=$$GET1^DIQ(9000010,BDGV,.14) ;cmi/maw 10/20/2008 PATCH 1010 orig line
;I X]"" S Y=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,.14) ;cmi/maw 10/20/2008 PATCH 1010 orig line
S X=$$GET1^DIQ(9000010,BDGV,1106) ;cmi/maw 10/20/2008 PATCH 1010 new export date
I X]"" S Y=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,1106) ;cmi/maw 10/20/2008 PATCH 1010 new export date
D MSG^BDGF(Y,2,0)
;
NEW APCDPARM,APCDVSIT,APCDLVST,APCDDATE,APCDTYPE
S APCDPARM=$G(^APCDSITE(DUZ(2),0))
S APCDVSIT=BDGV,APCDLVST=BDGV,APCDPAT=DFN
S (APCDVLDT,APCDDATE)=$$GET1^DIQ(9000010,BDGV,.01,"I")
S APCDTYPE=$$GET1^DIQ(9000010,BDGV,.03,"I")
D ^APCDVCHK,PAUSE^BDGF
S VALMBCK="R"
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CHECK(1)
;
;IHS/OIT/LJF 04/06/2006 PATCH 1005 trigger date coded in NICE if coding complete
NEW ICN,VH
S ICN=$O(^BDGIC("AV",BDGV,0)) ;find IC entry based on visit
S VH=$O(^AUPNVINP("AD",BDGV,0)) ;find v hosp entry
I ICN,VH,$$GET1^DIQ(9000010.02,VH,.15)="",$$GET1^DIQ(9009016.1,ICN,.13)="" D
. S DIE="^BDGIC(",DA=ICN,DR=".13///"_DT D ^DIE ;stuff date coded
. I $$GET1^DIQ(9009016.1,ICN,.22)="" S DR=".22///`"_DUZ D ^DIE ;stuff who coded chart
;end of PATCH 1005 code
;
K ^TMP("BDGPCCE",$J) K BDGV,DFN D KILL^AUPNPAT
Q
;
EXPND ; -- expand code
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
;
;IHS/OIT/LJF 03/16/2006 PATCH 1005 added HF & PED & global refs
MNE ;;
;;PV;;^AUPNVPOV;;
;;OP;;^AUPNVPRC;;
;;PRV;;^AUPNVPRV;;
;;ADX;;
;;IM;;^AUPNVIMM;;
;;HF;;^AUPNVHF;;
;;PED;;^AUPNVPED;;
BDGPCCEL ; IHS/ANMC/LJF - CODE PCC VISIT LISTING ; [ 08/12/2002 10:14 AM ]
+1 ;;5.3;PIMS;**1005,1006,1010**;MAY 28, 2004
+2 ;IHS/OIT/LJF 03/16/2006 PATCH 1005 added HF & PED mnemonic choices
+3 ; drops into ADD mode if nothing to MODIFY
+4 ; 04/06/2006 patch 1005 added trigger to stuff date coded in NICE
+5 ; prevent ^DGPMEX from asking patient name again
+6 ; 07/07/2006 PATCH 1006 prevent error if no mnemonic is selected
+7 ;cmi/anch/maw 10/20/2008 PATCH 1010 changed date exported field from .14 to 1106
+8 ;
EN ; -- main entry point for BDG IC CODE
+1 ; Assumes DFN and BDGV are set
+2 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+3 DO EN^VALM("BDG IC CODE")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW X,Y,VH
+2 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+3 ;
+4 SET X=$$GET1^DIQ(2,DFN,.01)_$$SP(5)_"#"_$$HRCN^BDGF2(DFN,DUZ(2))
+5 SET VALMHDR(2)=$$SP(79-$LENGTH(X)\2)_X
+6 ;
+7 SET VH=$ORDER(^AUPNVINP("AD",BDGV,0))
IF 'VH
QUIT
+8 SET X=$$GET1^DIQ(9000010.02,VH,.15)
+9 SET Y="Coding Complete? "_$SELECT(X="NO":"NO",1:"YES")
+10 ;S VALMHDR(3)=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,.14) ;cmi/maw 10/10/2008 PATCH 1010 orig line
+11 ;cmi/maw 10/10/2008 PATCH 1010 new export date
SET VALMHDR(3)=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,1106)
+12 QUIT
+13 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("BDGPCCE",$JOB)
+2 SET VALMCNT=0
+3 DO MSG^BDGF("Please wait while I gather all visit data...",2,0)
+4 ;build display screens
DO ^BDGPCCE1
+5 QUIT
+6 ;
ADMIT ;EP; called by Admission Data protocol
+1 DO FULL^VALM1
+2 ;
+3 IF '$ORDER(^DGPM("AVISIT",BDGV,0))
Begin DoDot:1
+4 DO MSG^BDGF("Visit NOT linked to ADT Admission",2,0)
+5 DO MSG^BDGF("Cannot continue. Please advise your supervisor.",1,0)
+6 DO PAUSE^BDGF
End DoDot:1
QUIT
+7 ;
+8 NEW BDGVH
+9 SET BDGVH=$ORDER(^AUPNVINP("AD",BDGV,0))
IF 'BDGVH
Begin DoDot:1
+10 DO MSG^BDGF("No V Hospitalization linked with Visit!!!",2,0)
+11 DO MSG^BDGF("Cannot continue. Please advise your supervisor.",1,0)
+12 DO PAUSE^BDGF
End DoDot:1
QUIT
+13 ;
+14 ; add/edit # of consults and admitting dx
+15 LOCK +^AUPNVINP(BDGVH):3
IF '$TEST
Begin DoDot:1
+16 DO MSG^BDGF("Someone else is updating this hospitalization.",2,0)
+17 DO MSG^BDGF("Please try again later.",1,0)
DO PAUSE^BDGF
End DoDot:1
QUIT
+18 KILL DIE,DA,DR
SET DIE="^AUPNVINP("
SET DA=BDGVH
SET DR=".08;.12"
DO ^DIE
DO EDIT
+19 LOCK -^AUPNVINP(BDGVH)
+20 ;
+21 ; add/edit DRG
+22 LOCK +^AUPNVSIT(BDGV):3
IF '$TEST
Begin DoDot:1
+23 DO MSG^BDGF("Someone else is updating this visit.",2,0)
+24 DO MSG^BDGF("Please try again later.",1,0)
DO PAUSE^BDGF
End DoDot:1
QUIT
+25 KILL DIE,DA,DR
SET DIE="^AUPNVSIT("
SET DA=BDGV
SET DR=".34"
DO ^DIE
DO EDIT
+26 LOCK -^AUPNVSIT(BDGV)
+27 ;
+28 ; call ADT to edit common fields
+29 NEW DGPMCA,DGPMEX,DGPMAN,BDGDFN
+30 SET DGPMCA=$ORDER(^DGPM("AVISIT",BDGV,0))
SET DGPMEX=""
+31 SET DGPMAN=$GET(^DGPM(+DGPMCA,0))
SET BDGDFN=DFN
+32 SET ^DISV(DUZ,"DGPMEX",DFN)=DGPMCA
+33 ;
+34 ;IHS/OIT/LJF 04/06/2006 PATCH 1005 set BDGCODE to prevent asking patient name again
+35 NEW BDGCODE
SET BDGCODE=1
+36 ;
+37 ;call extended bed control
DO ENEX^DGPMV20
DO ASK^DGPMEX
DO EDIT
+38 ;reset patient variables
SET (DFN,AUPNPAT)=BDGDFN
DO SETPT^BDGF(DFN)
+39 ;
+40 DO RESET
+41 QUIT
+42 ;
ADD ;EP; called by Add/Modify PCC Data protocol
+1 NEW APCDCAT,APCDVSIT,APCDPAT,APCDLOC,APCDTYPE,APCDMODE,APCDPARM
+2 NEW APCDMNE,BDGMN,BDGA,Y,APCDVLDT,APCDVLK,BDGBL,DIC
+3 SET APCDCAT="H"
SET (APCDVSIT,APCDVLK)=BDGV
SET APCDPAT=DFN
+4 SET APCDPARM=$GET(^APCDSITE(DUZ(2),0))
+5 SET (APCDDATE,APCDVLDT)=$$GET1^DIQ(9000010,BDGV,.01,"I")
+6 SET APCDLOC=DUZ(2)
SET APCDTYPE=$$GET1^DIQ(9000010,BDGV,.03,"I")
+7 ;
+8 DO FULL^VALM1
DO ^APCDEIN
ASK ;
+1 ;IHS/OIT/LJF 03/16/2006 PATCH 1005 rewrote subrtn to handle HF and PED
+2 KILL BDGA,APCDMNE
WRITE !!
+3 SET BDGA(1)=" (1) DIAGNOSIS (5) IMMUNIZATIONS"
+4 SET BDGA(2)=" (2) PROCEDURES (6) HEALTH FACTORS"
+5 SET BDGA(3)=" (3) PROVIDERS (7) PATIENT EDUCATION"
+6 SET BDGA(4)=" (4) ADMITTING DX (8) OTHER MNEMONICS"
+7 SET BDGMN=$$READ^BDGF("NO^1:8","Select One","","","",.BDGA)
+8 IF 'BDGMN
DO ENDADD
QUIT
+9 ;
+10 ;IHS/OIT/LJF 07/07/2006 PATCH 1006 rewrote section
+11 ;I BDGMN=8 D Q
+12 IF BDGMN=8
Begin DoDot:1
+13 ;S Y=$$READ^BDGF("P^9001001:EMQZ","MNEMONIC")
+14 SET Y=$$READ^BDGF("P^9001001:EMQZ","MNEMONIC")
IF Y<1
QUIT
+15 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+16 SET APCDMODE=$$READ^BDGF("SO^A:ADD;M:MODIFY","Select MODE")
+17 ;D ^APCDEA3,ASK
+18 DO ^APCDEA3
End DoDot:1
DO ASK
QUIT
+19 ;
+20 IF '$TEST
SET DIC=9001001
SET DIC(0)=""
SET X=$PIECE($TEXT(MNE+BDGMN),";;",2)
DO ^DIC
+21 IF Y<1
DO ASK
QUIT
+22 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+23 SET BDGBL=$PIECE($TEXT(MNE+BDGMN),";;",3)
IF (BDGMN'=8)
IF (BDGBL="")
SET APCDMODE="M"
+24 IF '$TEST
Begin DoDot:1
+25 SET Y=BDGBL_"(""AD"","_BDGV_",0)"
IF '$ORDER(@Y)
SET APCDMODE="A"
QUIT
+26 SET APCDMODE=$$READ^BDGF("SO^A:ADD;M:MODIFY","Select MODE")
End DoDot:1
+27 IF (APCDMODE="")!(APCDMODE=U)
+28 ;
+29 DO ^APCDEA3
DO ASK
QUIT
+30 ;
+31 ; when done with coding, mark visit as edited and return to display
ENDADD DO EDIT
DO RESET
+1 QUIT
+2 ;
LIST ;EP; Called by List I Visits protocol
+1 DO EN^BDGPCCE2
SET VALMBCK="R"
QUIT
+2 ;
PROB ;EP; Called by Problem List Update protocol
+1 NEW VALMCNT
+2 ;public entry point, assumes DFN is set
DO EN1^APCDPL
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
ALL ;EP; Called by Display All Data protocol (BDG IC PCC DISPLAY ALL)
+1 ; Also called by BDG VIEW PCC protocol
+2 NEW APCDPAT,APCDVSIT
+3 SET APCDPAT=DFN
SET APCDVSIT=BDGV
+4 ;public entry point
DO ^APCDVD
+5 DO EN^XBVK("APCD")
SET VALMBCK="R"
+6 QUIT
+7 ;
FASH ;EP; Called by Final A Sheet protocol
+1 NEW DGPMCA,BDGFIN
+2 DO FULL^VALM1
+3 SET DGPMCA=$ORDER(^DGPM("AVISIT",BDGV,0))
+4 SET BDGFIN=$$READ^BDGF("SO^1:A Sheet Only;2:A Sheet with CPT List;3:Medicare/Medicaid A Sheet","Select Report to Print",$$GET1^DIQ(9009020.1,$$DIV^BSDU,.07,"I"),"^D FINHLP^BDGCRB")
+5 IF 'BDGFIN
SET VALMBCK="R"
QUIT
+6 DO PAT^BDGCRB(DFN,DGPMCA,BDGFIN,1,2)
+7 DO PAUSE^BDGF
SET VALMBCK="R"
+8 QUIT
+9 ;
RESET ;EP; return from protocol & rebuild list
+1 SET VALMBCK="R"
DO TERM^VALM0
DO HDR
DO INIT
QUIT
+2 ;
EDIT ; update date last edited
+1 NEW AUPNVSIT
SET AUPNVSIT=BDGV
DO MOD^AUPNVSIT
QUIT
+2 ;
CHECK(DATE) ;EP; run inpatient edit check
+1 ; DATE=1 if check to be run only if updated today
+2 ; DATE=0 run check anyway
+3 IF DATE
IF $$GET1^DIQ(9000010,BDGV,.13,"I")'=DT
QUIT
+4 ;
+5 NEW BDGVH,X,Y
+6 SET BDGVH=$ORDER(^AUPNVINP("AD",BDGV,0))
IF 'BDGVH
QUIT
+7 DO FULL^VALM1
+8 SET X=$$GET1^DIQ(9000010.02,BDGVH,.15)
+9 SET Y="Coding Complete? "_$SELECT(X="NO":"NO",1:"YES")
+10 ;S X=$$GET1^DIQ(9000010,BDGV,.14) ;cmi/maw 10/20/2008 PATCH 1010 orig line
+11 ;I X]"" S Y=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,.14) ;cmi/maw 10/20/2008 PATCH 1010 orig line
+12 ;cmi/maw 10/20/2008 PATCH 1010 new export date
SET X=$$GET1^DIQ(9000010,BDGV,1106)
+13 ;cmi/maw 10/20/2008 PATCH 1010 new export date
IF X]""
SET Y=$$PAD(Y,30)_"Exported on "_$$GET1^DIQ(9000010,BDGV,1106)
+14 DO MSG^BDGF(Y,2,0)
+15 ;
+16 NEW APCDPARM,APCDVSIT,APCDLVST,APCDDATE,APCDTYPE
+17 SET APCDPARM=$GET(^APCDSITE(DUZ(2),0))
+18 SET APCDVSIT=BDGV
SET APCDLVST=BDGV
SET APCDPAT=DFN
+19 SET (APCDVLDT,APCDDATE)=$$GET1^DIQ(9000010,BDGV,.01,"I")
+20 SET APCDTYPE=$$GET1^DIQ(9000010,BDGV,.03,"I")
+21 DO ^APCDVCHK
DO PAUSE^BDGF
+22 SET VALMBCK="R"
+23 QUIT
+24 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CHECK(1)
+2 ;
+3 ;IHS/OIT/LJF 04/06/2006 PATCH 1005 trigger date coded in NICE if coding complete
+4 NEW ICN,VH
+5 ;find IC entry based on visit
SET ICN=$ORDER(^BDGIC("AV",BDGV,0))
+6 ;find v hosp entry
SET VH=$ORDER(^AUPNVINP("AD",BDGV,0))
+7 IF ICN
IF VH
IF $$GET1^DIQ(9000010.02,VH,.15)=""
IF $$GET1^DIQ(9009016.1,ICN,.13)=""
Begin DoDot:1
+8 ;stuff date coded
SET DIE="^BDGIC("
SET DA=ICN
SET DR=".13///"_DT
DO ^DIE
+9 ;stuff who coded chart
IF $$GET1^DIQ(9009016.1,ICN,.22)=""
SET DR=".22///`"_DUZ
DO ^DIE
End DoDot:1
+10 ;end of PATCH 1005 code
+11 ;
+12 KILL ^TMP("BDGPCCE",$JOB)
KILL BDGV,DFN
DO KILL^AUPNPAT
+13 QUIT
+14 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
+2 ;
+3 ;IHS/OIT/LJF 03/16/2006 PATCH 1005 added HF & PED & global refs
MNE ;;
+1 ;;PV;;^AUPNVPOV;;
+2 ;;OP;;^AUPNVPRC;;
+3 ;;PRV;;^AUPNVPRV;;
+4 ;;ADX;;
+5 ;;IM;;^AUPNVIMM;;
+6 ;;HF;;^AUPNVHF;;
+7 ;;PED;;^AUPNVPED;;
