- IBYPPCC ;ALB/TMP - IB*2*52 POST INSTALL: UPDATE HCFA 1500 ; 30-APR-1997
- ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
- ;
- EN N Z,Z0,Z1,DA,DIE,DIK,DR
- G:$O(^IBA(364.6,"ASEQ",2,1,""),-1)>62!($O(^IBA(364.6,"ASEQ",2,1,""))="") 1
- S Z="" F S Z=$O(^IBA(364.6,"ASEQ",2,1,Z),-1) Q:'Z S Z0="" F S Z0=$O(^IBA(364.6,"ASEQ",2,1,Z,Z0)) Q:'Z0 D
- .S Z1=0 F S Z1=$O(^IBA(364.6,"ASEQ",2,1,Z,Z0,Z1)) Q:'Z1 D
- ..S DIE="^IBA(364.6,",DA=Z1,DR=".05////"_(Z+1) D ^DIE
- I $D(^IBA(364.5,0)) D
- .S Z=0 F S Z=$O(^IBA(364.6,Z)) Q:'Z I '$D(^IBA(364.7,"B",Z)) S DA=Z,DIK="^IBA(364.6," D ^DIK
- .S Z=0 F S Z=$O(^IBA(364.7,"B",Z)) Q:'Z S Z0=+$O(^(Z,0)),DA=$O(^(Z0)) I DA S DIK="^IBA(364.7," D ^DIK
- ;
- 1 I $D(^IBA(364.5,0)) F Z=210:1:212 S DIK="^IBA(364.5,",DA=Z D ^DIK
- I $D(^IBA(364.7,"C",212)) S Z=0 F S Z=$O(^IBA(364.7,"C",212,Z)) Q:'Z S DIK="^IBA(364.7,",DA=Z D ^DIK
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYPPCC 881 printed Feb 19, 2025@00:02:54 Page 2
- IBYPPCC ;ALB/TMP - IB*2*52 POST INSTALL: UPDATE HCFA 1500 ; 30-APR-1997
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
- +2 ;
- EN NEW Z,Z0,Z1,DA,DIE,DIK,DR
- +1 if $ORDER(^IBA(364.6,"ASEQ",2,1,""),-1)>62!($ORDER(^IBA(364.6,"ASEQ",2,1,""))="")
- GOTO 1
- +2 SET Z=""
- FOR
- SET Z=$ORDER(^IBA(364.6,"ASEQ",2,1,Z),-1)
- if 'Z
- QUIT
- SET Z0=""
- FOR
- SET Z0=$ORDER(^IBA(364.6,"ASEQ",2,1,Z,Z0))
- if 'Z0
- QUIT
- Begin DoDot:1
- +3 SET Z1=0
- FOR
- SET Z1=$ORDER(^IBA(364.6,"ASEQ",2,1,Z,Z0,Z1))
- if 'Z1
- QUIT
- Begin DoDot:2
- +4 SET DIE="^IBA(364.6,"
- SET DA=Z1
- SET DR=".05////"_(Z+1)
- DO ^DIE
- End DoDot:2
- End DoDot:1
- +5 IF $DATA(^IBA(364.5,0))
- Begin DoDot:1
- +6 SET Z=0
- FOR
- SET Z=$ORDER(^IBA(364.6,Z))
- if 'Z
- QUIT
- IF '$DATA(^IBA(364.7,"B",Z))
- SET DA=Z
- SET DIK="^IBA(364.6,"
- DO ^DIK
- +7 SET Z=0
- FOR
- SET Z=$ORDER(^IBA(364.7,"B",Z))
- if 'Z
- QUIT
- SET Z0=+$ORDER(^(Z,0))
- SET DA=$ORDER(^(Z0))
- IF DA
- SET DIK="^IBA(364.7,"
- DO ^DIK
- End DoDot:1
- +8 ;
- 1 IF $DATA(^IBA(364.5,0))
- FOR Z=210:1:212
- SET DIK="^IBA(364.5,"
- SET DA=Z
- DO ^DIK
- +1 IF $DATA(^IBA(364.7,"C",212))
- SET Z=0
- FOR
- SET Z=$ORDER(^IBA(364.7,"C",212,Z))
- if 'Z
- QUIT
- SET DIK="^IBA(364.7,"
- SET DA=Z
- DO ^DIK
- +2 QUIT
- +3 ;
