- BDGADS2 ; IHS/ANMC/LJF - A&D SUMMARY-DAY SURGERY ;
- ;;5.3;PIMS;**1007**;FEB 27, 2007
- ;
- ;cmi/anch/maw 2/22/2007 added day surgery release date/time PATCH 1007 item 1007.36
- ;
- ; check VA Surgery file for data
- S X="BSRPEP" X ^%ZOSF("TEST") I $T D Q
- . NEW DAYCT,DGDS
- . S DAYCT=$$ADS^BSRPEP("S",BDGT) ;returns DGDS array
- . I DAYCT>0 D LINES
- ;
- ;
- ; And then IHS Day Surgery file
- NEW DATE,DFN,DSN,DAYCT,DGDS,NAME,DGZ
- S DATE=BDGT-.0001,END=BDGT+.24,DGDAYCT=0
- F S DATE=$O(^ADGDS("AA",DATE)) Q:'DATE Q:DATE>END D
- . S DFN=0
- . F S DFN=$O(^ADGDS("AA",DATE,DFN)) Q:'DFN D
- .. S DSN=0 F S DSN=$O(^ADGDS("AA",DATE,DFN,DSN)) Q:'DSN D
- ... ;
- ... Q:'$D(^ADGDS(DFN,"DS",DSN,0)) S DGZ=^(0)
- ... ;IHS/ITSC/WAR 10/31/03 Chgd next line
- ... ;I $P($G(^ADGDS(DFN,"DS",DGDSN,2)),U,3,4)["Y" Q ;noshow/cancel
- ... I $P($G(^ADGDS(DFN,"DS",DSN,2)),U,3,4)["Y" Q ;noshow/cancel
- ... S RELDT=$$FMTE^XLFDT($P($G(^ADGDS(DFN,"DS",DSN,2)),U)) ;release date cmi/anch/maw 2/22/2007 PATCH 1007 item 1007.36
- ... ;
- ... S NAME=$$GET1^DIQ(2,DFN,.01) ;patient name
- ... S DGDS(NAME,DFN)=$P(DGZ,U,5) ;service ien
- ... S $P(DGDS(NAME,DFN),U,5)=$G(RELDT) ;cmi/anch/maw 2/22/2007 PATCH 1007 item 1007.36
- ... S DAYCT=$G(DAYCT)+1
- ;
- I $G(DAYCT)>0 D LINES
- Q
- ;
- ;
- LINES ; loop thru day surgery patients found and list in alpha order
- NEW NAME,DFN
- ;
- D SET^BDGADS($$SP(5)_"Day Surgeries: "_DAYCT,.VALMCNT)
- D SET^BDGADS($$REPEAT^XLFSTR("-",48),.VALMCNT)
- ;
- S NAME=0 F S NAME=$O(DGDS(NAME)) Q:NAME="" D
- . S DFN=0 F S DFN=$O(DGDS(NAME,DFN)) Q:'DFN D LINE
- Q
- ;
- LINE ; set up display line
- NEW LINE
- S LINE=$$GET1^DIQ(45.7,+$P(DGDS(NAME,DFN),U),99) ;service
- S LINE=$$PAD(LINE,6)_$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
- S LINE=$$PAD(LINE,16)_$E(NAME,1,20) ;name
- S LINE=$$PAD(LINE,40)_$P(DGDS(NAME,DFN),U,2) ;va status
- S LINE=$$PAD(LINE,50)_$P(DGDS(NAME,DFN),U,5) ;release date cmi/anch/maw 2/22/2007 added PATCH 1007 item 1007.36
- D SET^BDGADS(LINE,.VALMCNT)
- 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)
- BDGADS2 ; IHS/ANMC/LJF - A&D SUMMARY-DAY SURGERY ;
- +1 ;;5.3;PIMS;**1007**;FEB 27, 2007
- +2 ;
- +3 ;cmi/anch/maw 2/22/2007 added day surgery release date/time PATCH 1007 item 1007.36
- +4 ;
- +5 ; check VA Surgery file for data
- +6 SET X="BSRPEP"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- Begin DoDot:1
- +7 NEW DAYCT,DGDS
- +8 ;returns DGDS array
- SET DAYCT=$$ADS^BSRPEP("S",BDGT)
- +9 IF DAYCT>0
- DO LINES
- End DoDot:1
- QUIT
- +10 ;
- +11 ;
- +12 ; And then IHS Day Surgery file
- +13 NEW DATE,DFN,DSN,DAYCT,DGDS,NAME,DGZ
- +14 SET DATE=BDGT-.0001
- SET END=BDGT+.24
- SET DGDAYCT=0
- +15 FOR
- SET DATE=$ORDER(^ADGDS("AA",DATE))
- IF 'DATE
- QUIT
- IF DATE>END
- QUIT
- Begin DoDot:1
- +16 SET DFN=0
- +17 FOR
- SET DFN=$ORDER(^ADGDS("AA",DATE,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +18 SET DSN=0
- FOR
- SET DSN=$ORDER(^ADGDS("AA",DATE,DFN,DSN))
- IF 'DSN
- QUIT
- Begin DoDot:3
- +19 ;
- +20 IF '$DATA(^ADGDS(DFN,"DS",DSN,0))
- QUIT
- SET DGZ=^(0)
- +21 ;IHS/ITSC/WAR 10/31/03 Chgd next line
- +22 ;I $P($G(^ADGDS(DFN,"DS",DGDSN,2)),U,3,4)["Y" Q ;noshow/cancel
- +23 ;noshow/cancel
- IF $PIECE($GET(^ADGDS(DFN,"DS",DSN,2)),U,3,4)["Y"
- QUIT
- +24 ;release date cmi/anch/maw 2/22/2007 PATCH 1007 item 1007.36
- SET RELDT=$$FMTE^XLFDT($PIECE($GET(^ADGDS(DFN,"DS",DSN,2)),U))
- +25 ;
- +26 ;patient name
- SET NAME=$$GET1^DIQ(2,DFN,.01)
- +27 ;service ien
- SET DGDS(NAME,DFN)=$PIECE(DGZ,U,5)
- +28 ;cmi/anch/maw 2/22/2007 PATCH 1007 item 1007.36
- SET $PIECE(DGDS(NAME,DFN),U,5)=$GET(RELDT)
- +29 SET DAYCT=$GET(DAYCT)+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 IF $GET(DAYCT)>0
- DO LINES
- +32 QUIT
- +33 ;
- +34 ;
- LINES ; loop thru day surgery patients found and list in alpha order
- +1 NEW NAME,DFN
- +2 ;
- +3 DO SET^BDGADS($$SP(5)_"Day Surgeries: "_DAYCT,.VALMCNT)
- +4 DO SET^BDGADS($$REPEAT^XLFSTR("-",48),.VALMCNT)
- +5 ;
- +6 SET NAME=0
- FOR
- SET NAME=$ORDER(DGDS(NAME))
- IF NAME=""
- QUIT
- Begin DoDot:1
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(DGDS(NAME,DFN))
- IF 'DFN
- QUIT
- DO LINE
- End DoDot:1
- +8 QUIT
- +9 ;
- LINE ; set up display line
- +1 NEW LINE
- +2 ;service
- SET LINE=$$GET1^DIQ(45.7,+$PIECE(DGDS(NAME,DFN),U),99)
- +3 SET LINE=$$PAD(LINE,6)_$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
- +4 ;name
- SET LINE=$$PAD(LINE,16)_$EXTRACT(NAME,1,20)
- +5 ;va status
- SET LINE=$$PAD(LINE,40)_$PIECE(DGDS(NAME,DFN),U,2)
- +6 ;release date cmi/anch/maw 2/22/2007 added PATCH 1007 item 1007.36
- SET LINE=$$PAD(LINE,50)_$PIECE(DGDS(NAME,DFN),U,5)
- +7 DO SET^BDGADS(LINE,.VALMCNT)
- +8 QUIT
- +9 ;
- 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)
