- BDGVHF ; IHS/ANMC/LJF - CREATE VHOSP IF MISSING ; [ 05/31/2002 4:22 PM ]
- ;;5.3;PIMS;**1005**;MAY 28, 2004
- ;IHS/OIT/LJF 04/26/2006 PATCH 1005 fixed date calls
- ;
- ;
- NEW BDGBD,BDGED
- ;IHS/OIT/LJF 04/26/2006 PATCH 1005
- ;S BDGBD=$$READ^BDGF("DO^::EQ","Beginning Discharge Date") Q:BDGBD<1
- ;S BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":EQ","Ending Discharge Date")
- S BDGBD=$$READ^BDGF("DO^::E","Beginning Discharge Date") Q:BDGBD<1
- S BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":E","Ending Discharge Date")
- ;
- Q:BDGED<1
- ;
- D ZIS^BDGF("PQ","LOOP^BDGVHF","FIX MISSING VHOSP","BDGBD;BDGED")
- Q
- ;
- ;
- LOOP ;EP; loop thru discharges to check for missing vhosps
- NEW DATE,DGEND,DSC,ADM,VST
- U IO D INIT,HED
- ;
- S DATE=BDGBD-.0001,DGEND=BDGED+.2400
- F S DATE=$O(^DGPM("ATT3",DATE)) Q:DATE=""!(DATE>DGEND) D
- . S DSC=0
- . F S DSC=$O(^DGPM("ATT3",DATE,DSC)) Q:DSC="" D
- .. S ADM=$$GET1^DIQ(405,DSC,.14,"I") Q:'ADM ;corresponding admission
- .. Q:'$G(^DGPM(ADM,0)) ;bad pointer
- .. ;
- .. ;IHS/ANMC/LJF 5/29/2002 fixed setting of VST and added check for
- .. ; deleted visit (per LJF3)
- .. ;S VST=$P($G(^DGPM(ADM,"IHS")),U)
- .. ;I $O(^AUPNVINP("AD",+VST,0)) Q ;entry okay
- .. S VST=$P($G(^DGPM(ADM,0)),U,27)
- .. I $O(^AUPNVINP("AD",+VST,0)),$P($G(^AUPNVSIT(+VST,0)),U,11)'=1 Q
- .. ;IHS/ANMC/LJF 5/29/2002 end of mods
- .. NEW DFN,DGPMA,DGPMCA
- .. S DFN=$$GET1^DIQ(405,DSC,.03,"I") ;patient ien
- .. S DGPMA=$G(^DGPM(DSC,0)) ;discharge node
- .. S DGPMCA=ADM
- .. W !,$$GET1^DIQ(405,DSC,.01),?20,$$GET1^DIQ(2,DFN,.01)
- .. D ADDVH^BDGPCCL
- ;
- I $E(IOST,1,2)="C-" D PAUSE^BDGF
- D ^%ZISC
- Q
- ;
- ;
- INIT ; initialize variables
- S DGPG=0,DGDUZ=$P(^VA(200,DUZ,0),U,2),DGSITE=$P(^DIC(4,DUZ(2),0),U)
- S DGLIN=$$REPEAT^XLFSTR("=",80),DGLIN2=$$REPEAT^XLFSTR("-",80)
- S DGQ=""
- Q
- ;
- HED ; -- heading
- I (DGPG>0)!(IOST["C-") W @IOF
- W !,DGLIN S DGPG=DGPG+1
- W !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- W !,DGDUZ,?80-$L(DGSITE)/2,DGSITE S DGTY="FIX MISSING V HOSP ENTRIES"
- W !,$$TIME^BDGF($$NOW^XLFDT),?80-$L(DGTY)/2,DGTY,?70,"Page: ",DGPG
- S Y=DT X ^DD("DD") W !,Y
- W !,DGLIN2,!
- Q
- ;
- BDGVHF ; IHS/ANMC/LJF - CREATE VHOSP IF MISSING ; [ 05/31/2002 4:22 PM ]
- +1 ;;5.3;PIMS;**1005**;MAY 28, 2004
- +2 ;IHS/OIT/LJF 04/26/2006 PATCH 1005 fixed date calls
- +3 ;
- +4 ;
- +5 NEW BDGBD,BDGED
- +6 ;IHS/OIT/LJF 04/26/2006 PATCH 1005
- +7 ;S BDGBD=$$READ^BDGF("DO^::EQ","Beginning Discharge Date") Q:BDGBD<1
- +8 ;S BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":EQ","Ending Discharge Date")
- +9 SET BDGBD=$$READ^BDGF("DO^::E","Beginning Discharge Date")
- IF BDGBD<1
- QUIT
- +10 SET BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":E","Ending Discharge Date")
- +11 ;
- +12 IF BDGED<1
- QUIT
- +13 ;
- +14 DO ZIS^BDGF("PQ","LOOP^BDGVHF","FIX MISSING VHOSP","BDGBD;BDGED")
- +15 QUIT
- +16 ;
- +17 ;
- LOOP ;EP; loop thru discharges to check for missing vhosps
- +1 NEW DATE,DGEND,DSC,ADM,VST
- +2 USE IO
- DO INIT
- DO HED
- +3 ;
- +4 SET DATE=BDGBD-.0001
- SET DGEND=BDGED+.2400
- +5 FOR
- SET DATE=$ORDER(^DGPM("ATT3",DATE))
- IF DATE=""!(DATE>DGEND)
- QUIT
- Begin DoDot:1
- +6 SET DSC=0
- +7 FOR
- SET DSC=$ORDER(^DGPM("ATT3",DATE,DSC))
- IF DSC=""
- QUIT
- Begin DoDot:2
- +8 ;corresponding admission
- SET ADM=$$GET1^DIQ(405,DSC,.14,"I")
- IF 'ADM
- QUIT
- +9 ;bad pointer
- IF '$GET(^DGPM(ADM,0))
- QUIT
- +10 ;
- +11 ;IHS/ANMC/LJF 5/29/2002 fixed setting of VST and added check for
- +12 ; deleted visit (per LJF3)
- +13 ;S VST=$P($G(^DGPM(ADM,"IHS")),U)
- +14 ;I $O(^AUPNVINP("AD",+VST,0)) Q ;entry okay
- +15 SET VST=$PIECE($GET(^DGPM(ADM,0)),U,27)
- +16 IF $ORDER(^AUPNVINP("AD",+VST,0))
- IF $PIECE($GET(^AUPNVSIT(+VST,0)),U,11)'=1
- QUIT
- +17 ;IHS/ANMC/LJF 5/29/2002 end of mods
- +18 NEW DFN,DGPMA,DGPMCA
- +19 ;patient ien
- SET DFN=$$GET1^DIQ(405,DSC,.03,"I")
- +20 ;discharge node
- SET DGPMA=$GET(^DGPM(DSC,0))
- +21 SET DGPMCA=ADM
- +22 WRITE !,$$GET1^DIQ(405,DSC,.01),?20,$$GET1^DIQ(2,DFN,.01)
- +23 DO ADDVH^BDGPCCL
- End DoDot:2
- End DoDot:1
- +24 ;
- +25 IF $EXTRACT(IOST,1,2)="C-"
- DO PAUSE^BDGF
- +26 DO ^%ZISC
- +27 QUIT
- +28 ;
- +29 ;
- INIT ; initialize variables
- +1 SET DGPG=0
- SET DGDUZ=$PIECE(^VA(200,DUZ,0),U,2)
- SET DGSITE=$PIECE(^DIC(4,DUZ(2),0),U)
- +2 SET DGLIN=$$REPEAT^XLFSTR("=",80)
- SET DGLIN2=$$REPEAT^XLFSTR("-",80)
- +3 SET DGQ=""
- +4 QUIT
- +5 ;
- HED ; -- heading
- +1 IF (DGPG>0)!(IOST["C-")
- WRITE @IOF
- +2 WRITE !,DGLIN
- SET DGPG=DGPG+1
- +3 WRITE !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- +4 WRITE !,DGDUZ,?80-$LENGTH(DGSITE)/2,DGSITE
- SET DGTY="FIX MISSING V HOSP ENTRIES"
- +5 WRITE !,$$TIME^BDGF($$NOW^XLFDT),?80-$LENGTH(DGTY)/2,DGTY,?70,"Page: ",DGPG
- +6 SET Y=DT
- XECUTE ^DD("DD")
- WRITE !,Y
- +7 WRITE !,DGLIN2,!
- +8 QUIT
- +9 ;
