BGP7DPE3 ; IHS/CMI/LAB - patient ed report ;
;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
;
;
SET73 ;EP
I BGPTIME=2 D SET73P Q
I BGPTIME=3 D SET73B Q
I '$D(^BGPPEDCG(BGPRPT,18,0)) S ^BGPPEDCG(BGPRPT,18,0)="^90558.1218A^0^0"
S Z=$O(^BGPPEDCG(BGPRPT,18,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDCG(BGPRPT,18,Z,0),U,3)=$P(^BGPPEDCG(BGPRPT,18,Z,0),U,3)+BGPC
S Z=$P(^BGPPEDCG(BGPRPT,18,0),U,3)+BGPC,$P(^BGPPEDCG(BGPRPT,18,0),U,3)=Z,$P(^BGPPEDCG(BGPRPT,18,0),U,4)=Z
S ^BGPPEDCG(BGPRPT,18,Z,0)=BGPT_U_BGPT_U_BGPC
S ^BGPPEDCG(BGPRPT,18,"B",BGPT,Z)=""
Q
SET73P ;
I '$D(^BGPPEDPG(BGPRPT,18,0)) S ^BGPPEDPG(BGPRPT,18,0)="^90558.1318A^0^0"
S Z=$O(^BGPPEDPG(BGPRPT,18,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDPG(BGPRPT,18,Z,0),U,3)=$P(^BGPPEDPG(BGPRPT,18,Z,0),U,3)+1
S Z=$P(^BGPPEDPG(BGPRPT,18,0),U,3)+1,$P(^BGPPEDPG(BGPRPT,18,0),U,3)=Z,$P(^BGPPEDPG(BGPRPT,18,0),U,4)=Z
S ^BGPPEDPG(BGPRPT,18,Z,0)=BGPT_U_BGPT_U_1
S ^BGPPEDPG(BGPRPT,18,"B",BGPT,Z)=""
Q
SET73B ;
I '$D(^BGPPEDBG(BGPRPT,18,0)) S ^BGPPEDBG(BGPRPT,18,0)="^90558.1418A^0^0"
S Z=$O(^BGPPEDBG(BGPRPT,18,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDBG(BGPRPT,18,Z,0),U,3)=$P(^BGPPEDBG(BGPRPT,18,Z,0),U,3)+1
S Z=$P(^BGPPEDBG(BGPRPT,18,0),U,3)+1,$P(^BGPPEDBG(BGPRPT,18,0),U,3)=Z,$P(^BGPPEDBG(BGPRPT,18,0),U,4)=Z
S ^BGPPEDBG(BGPRPT,18,Z,0)=BGPT_U_BGPT_U_1
S ^BGPPEDBG(BGPRPT,18,"B",BGPT,Z)=""
Q
SET74 ;EP
I BGPTIME=2 D SET74P Q
I BGPTIME=3 D SET74B Q
I '$D(^BGPPEDCG(BGPRPT,19,0)) S ^BGPPEDCG(BGPRPT,19,0)="^90558.1219A^0^0"
S Z=$O(^BGPPEDCG(BGPRPT,19,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDCG(BGPRPT,19,Z,0),U,3)=$P(^BGPPEDCG(BGPRPT,19,Z,0),U,3)+BGPC
S Z=$P(^BGPPEDCG(BGPRPT,19,0),U,3)+BGPC,$P(^BGPPEDCG(BGPRPT,19,0),U,3)=Z,$P(^BGPPEDCG(BGPRPT,19,0),U,4)=Z
S ^BGPPEDCG(BGPRPT,19,Z,0)=BGPT_U_BGPT_U_BGPC
S ^BGPPEDCG(BGPRPT,19,"B",BGPT,Z)=""
Q
SET74P ;
I '$D(^BGPPEDPG(BGPRPT,19,0)) S ^BGPPEDPG(BGPRPT,19,0)="^90558.1319A^0^0"
S Z=$O(^BGPPEDPG(BGPRPT,19,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDPG(BGPRPT,19,Z,0),U,3)=$P(^BGPPEDPG(BGPRPT,19,Z,0),U,3)+1
S Z=$P(^BGPPEDPG(BGPRPT,19,0),U,3)+1,$P(^BGPPEDPG(BGPRPT,19,0),U,3)=Z,$P(^BGPPEDPG(BGPRPT,19,0),U,4)=Z
S ^BGPPEDPG(BGPRPT,19,Z,0)=BGPT_U_BGPT_U_1
S ^BGPPEDPG(BGPRPT,19,"B",BGPT,Z)=""
Q
SET74B ;
I '$D(^BGPPEDBG(BGPRPT,19,0)) S ^BGPPEDBG(BGPRPT,19,0)="^90558.1419A^0^0"
S Z=$O(^BGPPEDBG(BGPRPT,19,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDBG(BGPRPT,19,Z,0),U,3)=$P(^BGPPEDBG(BGPRPT,19,Z,0),U,3)+1
S Z=$P(^BGPPEDBG(BGPRPT,19,0),U,3)+1,$P(^BGPPEDBG(BGPRPT,19,0),U,3)=Z,$P(^BGPPEDBG(BGPRPT,19,0),U,4)=Z
S ^BGPPEDBG(BGPRPT,19,Z,0)=BGPT_U_BGPT_U_1
S ^BGPPEDBG(BGPRPT,19,"B",BGPT,Z)=""
Q
SET75 ;EP
I BGPTIME=2 D SET75P Q
I BGPTIME=3 D SET75B Q
I '$D(^BGPPEDCG(BGPRPT,21,0)) S ^BGPPEDCG(BGPRPT,21,0)="^90558.1221A^0^0"
S Z=$O(^BGPPEDCG(BGPRPT,21,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDCG(BGPRPT,21,Z,0),U,3)=$P(^BGPPEDCG(BGPRPT,21,Z,0),U,3)+BGPC
S Z=$P(^BGPPEDCG(BGPRPT,21,0),U,3)+BGPC,$P(^BGPPEDCG(BGPRPT,21,0),U,3)=Z,$P(^BGPPEDCG(BGPRPT,21,0),U,4)=Z
S ^BGPPEDCG(BGPRPT,21,Z,0)=BGPT_U_BGPT_U_BGPC
S ^BGPPEDCG(BGPRPT,21,"B",BGPT,Z)=""
Q
SET75P ;
I '$D(^BGPPEDPG(BGPRPT,21,0)) S ^BGPPEDPG(BGPRPT,21,0)="^90558.1321A^0^0"
S Z=$O(^BGPPEDPG(BGPRPT,21,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDPG(BGPRPT,21,Z,0),U,3)=$P(^BGPPEDPG(BGPRPT,21,Z,0),U,3)+1
S Z=$P(^BGPPEDPG(BGPRPT,21,0),U,3)+1,$P(^BGPPEDPG(BGPRPT,21,0),U,3)=Z,$P(^BGPPEDPG(BGPRPT,21,0),U,4)=Z
S ^BGPPEDPG(BGPRPT,21,Z,0)=BGPT_U_BGPT_U_1
S ^BGPPEDPG(BGPRPT,21,"B",BGPT,Z)=""
Q
SET75B ;
I '$D(^BGPPEDBG(BGPRPT,21,0)) S ^BGPPEDBG(BGPRPT,21,0)="^90558.1421A^0^0"
S Z=$O(^BGPPEDBG(BGPRPT,21,"B",BGPT,0)) I Z D Q
.S $P(^BGPPEDBG(BGPRPT,21,Z,0),U,3)=$P(^BGPPEDBG(BGPRPT,21,Z,0),U,3)+1
S Z=$P(^BGPPEDBG(BGPRPT,21,0),U,3)+1,$P(^BGPPEDBG(BGPRPT,21,0),U,3)=Z,$P(^BGPPEDBG(BGPRPT,21,0),U,4)=Z
S ^BGPPEDBG(BGPRPT,21,Z,0)=BGPT_U_BGPT_U_1
S ^BGPPEDBG(BGPRPT,21,"B",BGPT,Z)=""
Q
BGP7DPE3 ; IHS/CMI/LAB - patient ed report ;
+1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
+2 ;
+3 ;
SET73 ;EP
+1 IF BGPTIME=2
DO SET73P
QUIT
+2 IF BGPTIME=3
DO SET73B
QUIT
+3 IF '$DATA(^BGPPEDCG(BGPRPT,18,0))
SET ^BGPPEDCG(BGPRPT,18,0)="^90558.1218A^0^0"
+4 SET Z=$ORDER(^BGPPEDCG(BGPRPT,18,"B",BGPT,0))
IF Z
Begin DoDot:1
+5 SET $PIECE(^BGPPEDCG(BGPRPT,18,Z,0),U,3)=$PIECE(^BGPPEDCG(BGPRPT,18,Z,0),U,3)+BGPC
End DoDot:1
QUIT
+6 SET Z=$PIECE(^BGPPEDCG(BGPRPT,18,0),U,3)+BGPC
SET $PIECE(^BGPPEDCG(BGPRPT,18,0),U,3)=Z
SET $PIECE(^BGPPEDCG(BGPRPT,18,0),U,4)=Z
+7 SET ^BGPPEDCG(BGPRPT,18,Z,0)=BGPT_U_BGPT_U_BGPC
+8 SET ^BGPPEDCG(BGPRPT,18,"B",BGPT,Z)=""
+9 QUIT
SET73P ;
+1 IF '$DATA(^BGPPEDPG(BGPRPT,18,0))
SET ^BGPPEDPG(BGPRPT,18,0)="^90558.1318A^0^0"
+2 SET Z=$ORDER(^BGPPEDPG(BGPRPT,18,"B",BGPT,0))
IF Z
Begin DoDot:1
+3 SET $PIECE(^BGPPEDPG(BGPRPT,18,Z,0),U,3)=$PIECE(^BGPPEDPG(BGPRPT,18,Z,0),U,3)+1
End DoDot:1
QUIT
+4 SET Z=$PIECE(^BGPPEDPG(BGPRPT,18,0),U,3)+1
SET $PIECE(^BGPPEDPG(BGPRPT,18,0),U,3)=Z
SET $PIECE(^BGPPEDPG(BGPRPT,18,0),U,4)=Z
+5 SET ^BGPPEDPG(BGPRPT,18,Z,0)=BGPT_U_BGPT_U_1
+6 SET ^BGPPEDPG(BGPRPT,18,"B",BGPT,Z)=""
+7 QUIT
SET73B ;
+1 IF '$DATA(^BGPPEDBG(BGPRPT,18,0))
SET ^BGPPEDBG(BGPRPT,18,0)="^90558.1418A^0^0"
+2 SET Z=$ORDER(^BGPPEDBG(BGPRPT,18,"B",BGPT,0))
IF Z
Begin DoDot:1
+3 SET $PIECE(^BGPPEDBG(BGPRPT,18,Z,0),U,3)=$PIECE(^BGPPEDBG(BGPRPT,18,Z,0),U,3)+1
End DoDot:1
QUIT
+4 SET Z=$PIECE(^BGPPEDBG(BGPRPT,18,0),U,3)+1
SET $PIECE(^BGPPEDBG(BGPRPT,18,0),U,3)=Z
SET $PIECE(^BGPPEDBG(BGPRPT,18,0),U,4)=Z
+5 SET ^BGPPEDBG(BGPRPT,18,Z,0)=BGPT_U_BGPT_U_1
+6 SET ^BGPPEDBG(BGPRPT,18,"B",BGPT,Z)=""
+7 QUIT
SET74 ;EP
+1 IF BGPTIME=2
DO SET74P
QUIT
+2 IF BGPTIME=3
DO SET74B
QUIT
+3 IF '$DATA(^BGPPEDCG(BGPRPT,19,0))
SET ^BGPPEDCG(BGPRPT,19,0)="^90558.1219A^0^0"
+4 SET Z=$ORDER(^BGPPEDCG(BGPRPT,19,"B",BGPT,0))
IF Z
Begin DoDot:1
+5 SET $PIECE(^BGPPEDCG(BGPRPT,19,Z,0),U,3)=$PIECE(^BGPPEDCG(BGPRPT,19,Z,0),U,3)+BGPC
End DoDot:1
QUIT
+6 SET Z=$PIECE(^BGPPEDCG(BGPRPT,19,0),U,3)+BGPC
SET $PIECE(^BGPPEDCG(BGPRPT,19,0),U,3)=Z
SET $PIECE(^BGPPEDCG(BGPRPT,19,0),U,4)=Z
+7 SET ^BGPPEDCG(BGPRPT,19,Z,0)=BGPT_U_BGPT_U_BGPC
+8 SET ^BGPPEDCG(BGPRPT,19,"B",BGPT,Z)=""
+9 QUIT
SET74P ;
+1 IF '$DATA(^BGPPEDPG(BGPRPT,19,0))
SET ^BGPPEDPG(BGPRPT,19,0)="^90558.1319A^0^0"
+2 SET Z=$ORDER(^BGPPEDPG(BGPRPT,19,"B",BGPT,0))
IF Z
Begin DoDot:1
+3 SET $PIECE(^BGPPEDPG(BGPRPT,19,Z,0),U,3)=$PIECE(^BGPPEDPG(BGPRPT,19,Z,0),U,3)+1
End DoDot:1
QUIT
+4 SET Z=$PIECE(^BGPPEDPG(BGPRPT,19,0),U,3)+1
SET $PIECE(^BGPPEDPG(BGPRPT,19,0),U,3)=Z
SET $PIECE(^BGPPEDPG(BGPRPT,19,0),U,4)=Z
+5 SET ^BGPPEDPG(BGPRPT,19,Z,0)=BGPT_U_BGPT_U_1
+6 SET ^BGPPEDPG(BGPRPT,19,"B",BGPT,Z)=""
+7 QUIT
SET74B ;
+1 IF '$DATA(^BGPPEDBG(BGPRPT,19,0))
SET ^BGPPEDBG(BGPRPT,19,0)="^90558.1419A^0^0"
+2 SET Z=$ORDER(^BGPPEDBG(BGPRPT,19,"B",BGPT,0))
IF Z
Begin DoDot:1
+3 SET $PIECE(^BGPPEDBG(BGPRPT,19,Z,0),U,3)=$PIECE(^BGPPEDBG(BGPRPT,19,Z,0),U,3)+1
End DoDot:1
QUIT
+4 SET Z=$PIECE(^BGPPEDBG(BGPRPT,19,0),U,3)+1
SET $PIECE(^BGPPEDBG(BGPRPT,19,0),U,3)=Z
SET $PIECE(^BGPPEDBG(BGPRPT,19,0),U,4)=Z
+5 SET ^BGPPEDBG(BGPRPT,19,Z,0)=BGPT_U_BGPT_U_1
+6 SET ^BGPPEDBG(BGPRPT,19,"B",BGPT,Z)=""
+7 QUIT
SET75 ;EP
+1 IF BGPTIME=2
DO SET75P
QUIT
+2 IF BGPTIME=3
DO SET75B
QUIT
+3 IF '$DATA(^BGPPEDCG(BGPRPT,21,0))
SET ^BGPPEDCG(BGPRPT,21,0)="^90558.1221A^0^0"
+4 SET Z=$ORDER(^BGPPEDCG(BGPRPT,21,"B",BGPT,0))
IF Z
Begin DoDot:1
+5 SET $PIECE(^BGPPEDCG(BGPRPT,21,Z,0),U,3)=$PIECE(^BGPPEDCG(BGPRPT,21,Z,0),U,3)+BGPC
End DoDot:1
QUIT
+6 SET Z=$PIECE(^BGPPEDCG(BGPRPT,21,0),U,3)+BGPC
SET $PIECE(^BGPPEDCG(BGPRPT,21,0),U,3)=Z
SET $PIECE(^BGPPEDCG(BGPRPT,21,0),U,4)=Z
+7 SET ^BGPPEDCG(BGPRPT,21,Z,0)=BGPT_U_BGPT_U_BGPC
+8 SET ^BGPPEDCG(BGPRPT,21,"B",BGPT,Z)=""
+9 QUIT
SET75P ;
+1 IF '$DATA(^BGPPEDPG(BGPRPT,21,0))
SET ^BGPPEDPG(BGPRPT,21,0)="^90558.1321A^0^0"
+2 SET Z=$ORDER(^BGPPEDPG(BGPRPT,21,"B",BGPT,0))
IF Z
Begin DoDot:1
+3 SET $PIECE(^BGPPEDPG(BGPRPT,21,Z,0),U,3)=$PIECE(^BGPPEDPG(BGPRPT,21,Z,0),U,3)+1
End DoDot:1
QUIT
+4 SET Z=$PIECE(^BGPPEDPG(BGPRPT,21,0),U,3)+1
SET $PIECE(^BGPPEDPG(BGPRPT,21,0),U,3)=Z
SET $PIECE(^BGPPEDPG(BGPRPT,21,0),U,4)=Z
+5 SET ^BGPPEDPG(BGPRPT,21,Z,0)=BGPT_U_BGPT_U_1
+6 SET ^BGPPEDPG(BGPRPT,21,"B",BGPT,Z)=""
+7 QUIT
SET75B ;
+1 IF '$DATA(^BGPPEDBG(BGPRPT,21,0))
SET ^BGPPEDBG(BGPRPT,21,0)="^90558.1421A^0^0"
+2 SET Z=$ORDER(^BGPPEDBG(BGPRPT,21,"B",BGPT,0))
IF Z
Begin DoDot:1
+3 SET $PIECE(^BGPPEDBG(BGPRPT,21,Z,0),U,3)=$PIECE(^BGPPEDBG(BGPRPT,21,Z,0),U,3)+1
End DoDot:1
QUIT
+4 SET Z=$PIECE(^BGPPEDBG(BGPRPT,21,0),U,3)+1
SET $PIECE(^BGPPEDBG(BGPRPT,21,0),U,3)=Z
SET $PIECE(^BGPPEDBG(BGPRPT,21,0),U,4)=Z
+5 SET ^BGPPEDBG(BGPRPT,21,Z,0)=BGPT_U_BGPT_U_1
+6 SET ^BGPPEDBG(BGPRPT,21,"B",BGPT,Z)=""
+7 QUIT
