BDGADD2 ; IHS/ANMC/LJF - A&D DETAILED-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("D",BDGT)
. I DAYCT>0 D LINES
;
; And then IHS Day Surgery file
NEW DATE,DFN,DSN,DGDS,DGZA,DAYCT,NAME,END,RELDT
S DATE=BDGT-.0001,END=BDGT+.24,DAYCT=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 11/24/03 TYPO
... ;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
... S X=$$GET1^DIQ(200,+$P(DGZ,U,6),.01) ;surgeon
... S DGDS(NAME,DFN)=X_U_$$GET1^DIQ(9000001,DFN,1102.99) ;and age
... S $P(DGDS(NAME,DFN),U,3)=$$GET1^DIQ(45.7,+$P(DGZ,U,5),.01) ;srv
... S $P(DGDS(NAME,DFN),U,4)=$$GET1^DIQ(9000001,DFN,1118) ;community
... 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) D LINES
Q
;
;
LINES ; loop thru patients found and list in alpha order
NEW NAME,DFN
;
D SET^BDGADD("",.VALMCNT)
D SET^BDGADD($$SP(5)_"Day Surgeries: "_DAYCT,.VALMCNT)
D SET^BDGADD($$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=$$SP(5)_$E($$GET1^DIQ(2,DFN,.01),1,20) ;name
S LINE=$$PAD(LINE,28)_$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
S LINE=$$PAD(LINE,38)_$E($P(DGDS(NAME,DFN),U),1,20) ;surgeon
S LINE=$$PAD(LINE,60)_$P(DGDS(NAME,DFN),U,2) ;age
S LINE=$$PAD(LINE,70)_$E($P(DGDS(NAME,DFN),U,3),1,18) ;service
S LINE=$$PAD(LINE,90)_$E($P(DGDS(NAME,DFN),U,4),1,20) ;village
S LINE=$$PAD(LINE,112)_$P(DGDS(NAME,DFN),U,5) ;release date cmi/anch/maw 2/22/2007 added PATCH 1007 item 1007.36
D SET^BDGADD(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)
BDGADD2 ; IHS/ANMC/LJF - A&D DETAILED-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 SET DAYCT=$$ADS^BSRPEP("D",BDGT)
+9 IF DAYCT>0
DO LINES
End DoDot:1
QUIT
+10 ;
+11 ; And then IHS Day Surgery file
+12 NEW DATE,DFN,DSN,DGDS,DGZA,DAYCT,NAME,END,RELDT
+13 SET DATE=BDGT-.0001
SET END=BDGT+.24
SET DAYCT=0
+14 FOR
SET DATE=$ORDER(^ADGDS("AA",DATE))
IF 'DATE
QUIT
IF DATE>END
QUIT
Begin DoDot:1
+15 SET DFN=0
+16 FOR
SET DFN=$ORDER(^ADGDS("AA",DATE,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+17 SET DSN=0
FOR
SET DSN=$ORDER(^ADGDS("AA",DATE,DFN,DSN))
IF 'DSN
QUIT
Begin DoDot:3
+18 ;
+19 IF '$DATA(^ADGDS(DFN,"DS",DSN,0))
QUIT
SET DGZ=^(0)
+20 ;IHS/ITSC/WAR 11/24/03 TYPO
+21 ;I $P($G(^ADGDS(DFN,"DS",DGDSN,2)),U,3,4)["Y" Q ;noshow/cancel
+22 ;noshow/cancel
IF $PIECE($GET(^ADGDS(DFN,"DS",DSN,2)),U,3,4)["Y"
QUIT
+23 ;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))
+24 ;
+25 ;patient
SET NAME=$$GET1^DIQ(2,DFN,.01)
+26 ;surgeon
SET X=$$GET1^DIQ(200,+$PIECE(DGZ,U,6),.01)
+27 ;and age
SET DGDS(NAME,DFN)=X_U_$$GET1^DIQ(9000001,DFN,1102.99)
+28 ;srv
SET $PIECE(DGDS(NAME,DFN),U,3)=$$GET1^DIQ(45.7,+$PIECE(DGZ,U,5),.01)
+29 ;community
SET $PIECE(DGDS(NAME,DFN),U,4)=$$GET1^DIQ(9000001,DFN,1118)
+30 ;cmi/anch/maw 2/22/2007 PATCH 1007 item 1007.36
SET $PIECE(DGDS(NAME,DFN),U,5)=$GET(RELDT)
+31 SET DAYCT=$GET(DAYCT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
+33 IF $GET(DAYCT)
DO LINES
+34 QUIT
+35 ;
+36 ;
LINES ; loop thru patients found and list in alpha order
+1 NEW NAME,DFN
+2 ;
+3 DO SET^BDGADD("",.VALMCNT)
+4 DO SET^BDGADD($$SP(5)_"Day Surgeries: "_DAYCT,.VALMCNT)
+5 DO SET^BDGADD($$REPEAT^XLFSTR("-",48),.VALMCNT)
+6 ;
+7 SET NAME=0
FOR
SET NAME=$ORDER(DGDS(NAME))
IF NAME=""
QUIT
Begin DoDot:1
+8 SET DFN=0
FOR
SET DFN=$ORDER(DGDS(NAME,DFN))
IF 'DFN
QUIT
DO LINE
End DoDot:1
+9 QUIT
+10 ;
LINE ; set up display line
+1 NEW LINE
+2 ;name
SET LINE=$$SP(5)_$EXTRACT($$GET1^DIQ(2,DFN,.01),1,20)
+3 SET LINE=$$PAD(LINE,28)_$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
+4 ;surgeon
SET LINE=$$PAD(LINE,38)_$EXTRACT($PIECE(DGDS(NAME,DFN),U),1,20)
+5 ;age
SET LINE=$$PAD(LINE,60)_$PIECE(DGDS(NAME,DFN),U,2)
+6 ;service
SET LINE=$$PAD(LINE,70)_$EXTRACT($PIECE(DGDS(NAME,DFN),U,3),1,18)
+7 ;village
SET LINE=$$PAD(LINE,90)_$EXTRACT($PIECE(DGDS(NAME,DFN),U,4),1,20)
+8 ;release date cmi/anch/maw 2/22/2007 added PATCH 1007 item 1007.36
SET LINE=$$PAD(LINE,112)_$PIECE(DGDS(NAME,DFN),U,5)
+9 DO SET^BDGADD(LINE,.VALMCNT)
+10 QUIT
+11 ;
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)
