BGP2UTL3 ; IHS/CMI/LAB - 27 Apr 2009 11:01 PM 30 Aug 2009 10:16 AM 30 Jun 2010 4:58 PM 05 Aug 2012 11:40 AM 26 Mar 2012 2:40 PM ;
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
ONN4 ;EP
K BGPEXCT
S Y=$$OPEN^%ZISH(BGPUF,BGPFONN4,"W")
I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q
U IO
S BGPP=0,BGPY=$O(^BGPCTRL("B","2012",0)),BGPX="",BGPEC=$P(^BGPCTRL(BGPY,0),U,25)
F S BGPP=$O(^BGPCTRL(BGPY,86,BGPP)) Q:BGPP'=+BGPP D
.S BGPPP1=$P(^BGPCTRL(BGPY,86,BGPP,0),U,1)
.S BGPZ=$P(^BGPCTRL(BGPY,86,BGPP,0),U,2)
.S $P(BGPX,U,BGPPP1)=BGPZ
W BGPX,!
K BGPX
S BGPX="" S P=11 F S $P(BGPX,U,P)="Current",P=P+9 Q:P>(BGPEC-8)
S P=14 F S $P(BGPX,U,P)="Previous",P=P+9 Q:P>(BGPEC-5)
S P=17 F S $P(BGPX,U,P)="Baseline",P=P+9 Q:P>(BGPEC+1)
W BGPX,!
K BGPX
D SETHDR^BGP2UTL
S P=11 F S $P(BGPX,U,P)="Num",P=P+3 Q:P>(BGPEC-2)
S P=12 F S $P(BGPX,U,P)="Den",P=P+3 Q:P>(BGPEC-1)
S P=13 F S $P(BGPX,U,P)="%",P=P+3 Q:P>BGPEC
W BGPX,!
S BGPX=0 F S BGPX=$O(BGPONN4(BGPX)) Q:BGPX'=+BGPX W BGPONN4(BGPX),!
K BGPONN4
D ^%ZISC
ONN5 ;
K BGPEXCT
S Y=$$OPEN^%ZISH(BGPUF,BGPFONN5,"W")
I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file." Q
U IO
S BGPP=0,BGPY=$O(^BGPCTRL("B","2012",0)),BGPX="",BGPEC=$P(^BGPCTRL(BGPY,0),U,26)
F S BGPP=$O(^BGPCTRL(BGPY,87,BGPP)) Q:BGPP'=+BGPP D
.S BGPPP1=$P(^BGPCTRL(BGPY,87,BGPP,0),U,1)
.S BGPZ=$P(^BGPCTRL(BGPY,87,BGPP,0),U,2)
.S $P(BGPX,U,BGPPP1)=BGPZ
W BGPX,!
K BGPX
S BGPX="" S P=11 F S $P(BGPX,U,P)="Current",P=P+9 Q:P>(BGPEC-8)
S P=14 F S $P(BGPX,U,P)="Previous",P=P+9 Q:P>(BGPEC-5)
S P=17 F S $P(BGPX,U,P)="Baseline",P=P+9 Q:P>(BGPEC+1)
W BGPX,!
K BGPX
D SETHDR^BGP2UTL
S P=11 F S $P(BGPX,U,P)="Num",P=P+3 Q:P>(BGPEC-2)
S P=12 F S $P(BGPX,U,P)="Den",P=P+3 Q:P>(BGPEC-1)
S P=13 F S $P(BGPX,U,P)="%",P=P+3 Q:P>BGPEC
W BGPX,!
S BGPX=0 F S BGPX=$O(BGPONN5(BGPX)) Q:BGPX'=+BGPX W BGPONN5(BGPX),!
K BGPONN5
ONNC D ^%ZISC ;close host file
Q
BGP2UTL3 ; IHS/CMI/LAB - 27 Apr 2009 11:01 PM 30 Aug 2009 10:16 AM 30 Jun 2010 4:58 PM 05 Aug 2012 11:40 AM 26 Mar 2012 2:40 PM ;
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
ONN4 ;EP
+1 KILL BGPEXCT
+2 SET Y=$$OPEN^%ZISH(BGPUF,BGPFONN4,"W")
+3 IF Y=1
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot open host file."
QUIT
+4 USE IO
+5 SET BGPP=0
SET BGPY=$ORDER(^BGPCTRL("B","2012",0))
SET BGPX=""
SET BGPEC=$PIECE(^BGPCTRL(BGPY,0),U,25)
+6 FOR
SET BGPP=$ORDER(^BGPCTRL(BGPY,86,BGPP))
IF BGPP'=+BGPP
QUIT
Begin DoDot:1
+7 SET BGPPP1=$PIECE(^BGPCTRL(BGPY,86,BGPP,0),U,1)
+8 SET BGPZ=$PIECE(^BGPCTRL(BGPY,86,BGPP,0),U,2)
+9 SET $PIECE(BGPX,U,BGPPP1)=BGPZ
End DoDot:1
+10 WRITE BGPX,!
+11 KILL BGPX
+12 SET BGPX=""
SET P=11
FOR
SET $PIECE(BGPX,U,P)="Current"
SET P=P+9
IF P>(BGPEC-8)
QUIT
+13 SET P=14
FOR
SET $PIECE(BGPX,U,P)="Previous"
SET P=P+9
IF P>(BGPEC-5)
QUIT
+14 SET P=17
FOR
SET $PIECE(BGPX,U,P)="Baseline"
SET P=P+9
IF P>(BGPEC+1)
QUIT
+15 WRITE BGPX,!
+16 KILL BGPX
+17 DO SETHDR^BGP2UTL
+18 SET P=11
FOR
SET $PIECE(BGPX,U,P)="Num"
SET P=P+3
IF P>(BGPEC-2)
QUIT
+19 SET P=12
FOR
SET $PIECE(BGPX,U,P)="Den"
SET P=P+3
IF P>(BGPEC-1)
QUIT
+20 SET P=13
FOR
SET $PIECE(BGPX,U,P)="%"
SET P=P+3
IF P>BGPEC
QUIT
+21 WRITE BGPX,!
+22 SET BGPX=0
FOR
SET BGPX=$ORDER(BGPONN4(BGPX))
IF BGPX'=+BGPX
QUIT
WRITE BGPONN4(BGPX),!
+23 KILL BGPONN4
+24 DO ^%ZISC
ONN5 ;
+1 KILL BGPEXCT
+2 SET Y=$$OPEN^%ZISH(BGPUF,BGPFONN5,"W")
+3 IF Y=1
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot open host file."
QUIT
+4 USE IO
+5 SET BGPP=0
SET BGPY=$ORDER(^BGPCTRL("B","2012",0))
SET BGPX=""
SET BGPEC=$PIECE(^BGPCTRL(BGPY,0),U,26)
+6 FOR
SET BGPP=$ORDER(^BGPCTRL(BGPY,87,BGPP))
IF BGPP'=+BGPP
QUIT
Begin DoDot:1
+7 SET BGPPP1=$PIECE(^BGPCTRL(BGPY,87,BGPP,0),U,1)
+8 SET BGPZ=$PIECE(^BGPCTRL(BGPY,87,BGPP,0),U,2)
+9 SET $PIECE(BGPX,U,BGPPP1)=BGPZ
End DoDot:1
+10 WRITE BGPX,!
+11 KILL BGPX
+12 SET BGPX=""
SET P=11
FOR
SET $PIECE(BGPX,U,P)="Current"
SET P=P+9
IF P>(BGPEC-8)
QUIT
+13 SET P=14
FOR
SET $PIECE(BGPX,U,P)="Previous"
SET P=P+9
IF P>(BGPEC-5)
QUIT
+14 SET P=17
FOR
SET $PIECE(BGPX,U,P)="Baseline"
SET P=P+9
IF P>(BGPEC+1)
QUIT
+15 WRITE BGPX,!
+16 KILL BGPX
+17 DO SETHDR^BGP2UTL
+18 SET P=11
FOR
SET $PIECE(BGPX,U,P)="Num"
SET P=P+3
IF P>(BGPEC-2)
QUIT
+19 SET P=12
FOR
SET $PIECE(BGPX,U,P)="Den"
SET P=P+3
IF P>(BGPEC-1)
QUIT
+20 SET P=13
FOR
SET $PIECE(BGPX,U,P)="%"
SET P=P+3
IF P>BGPEC
QUIT
+21 WRITE BGPX,!
+22 SET BGPX=0
FOR
SET BGPX=$ORDER(BGPONN5(BGPX))
IF BGPX'=+BGPX
QUIT
WRITE BGPONN5(BGPX),!
+23 KILL BGPONN5
ONNC ;close host file
DO ^%ZISC
+1 QUIT
