- 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;;