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)
