- IBJDF8I ;ALB/RRG-ADD/EDIT IB DM WORKLOAD PARAMETERS ;11/06/00
- ;;2.0;INTEGRATED BILLING;**123,604**;21-MAR-94;Build 11
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- START D BEG G EXIT:IBQUIT I IBPRONLY G START
- D ASSIGN G START:IBQUIT
- I IBJOB="A" D ADD G START:IBQUIT
- I IBJOB="E" D EDIT^IBJDF8I1 G START:IBQUIT
- I IBJOB="D" D DELETE G START:IBQUIT
- L -^IBE(351.73,IBCL)
- G START
- Q
- ;
- BEG ;Start editing workload paramters
- N DIC,IBDELFLG S (IBQUIT,IBPRONLY)=0 S (IBDA0,IBCL)="",IBDELFLG=1
- ;S DIC="^IBE(351.73,",DIC(0)="QEAML",DLAYGO=351.73,DIC("A")="Select Clerk: " ; IB*2.0*604 - original code
- S DIC="^VA(200,",DIC(0)="QEAMV",DIC("A")="Select Clerk: " ; *604-Search NEW PERSON (#200) file for clerk
- D ^DIC I ($D(DTOUT))!($D(DUOUT))!(Y'>0) S IBQUIT=1 Q
- ; *604-Use IEN of entry found in file #200 to search file #351.73
- ; If no match is found in #351.73, allow a new entry to be made using the existing entry in #200
- S X=+Y,DIC="^IBE(351.73,",DIC(0)="QELUX",DLAYGO=351.73 ; *604
- D ^DIC I ($D(DTOUT))!($D(DUOUT))!(Y'>0) S IBQUIT=1 Q ; *604
- S IBCL=+Y W !
- L +^IBE(351.73,IBCL):2 I '$T W !?3,"Another user is editing this entry." G BEG
- I $P(^IBE(351.73,IBCL,0),"^",3)="" D
- . S DIE=DIC,DR=".03////"_DUZ,DA=IBCL D ^DIE K DIE,DR,DA
- PRONLY S DIR(0)="351.73,.02",DA=IBCL,IBDELFLG=1
- D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) L -^IBE(351.73,IBCL) G BEG
- S IBPRONLY=Y K DIROUT,DTOUT,DUOUT
- I 'IBPRONLY S $P(^IBE(351.73,IBCL,0),"^",2)=0 Q
- I IBPRONLY D Q:IBQUIT I 'IBDELFLG G PRONLY
- . I $O(^IBE(351.73,IBCL,1,0)) D
- . . S DIR(0)="Y",DIR("B")="NO"
- . . S DIR("A",1)="There are existing assignments for this clerk."
- . . S DIR("A",2)="Those assignments must be deleted before the 'Productivity Report Only'"
- . . S DIR("A",3)=" flag can be changed to 'Yes'."
- . . S DIR("A")="Do you want to delete the existing assignments now"
- . . D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) L -^IBE(351.73,IBCL) S IBQUIT=1 Q
- . . K DIROUT,DTOUT,DUOUT I 'Y S IBDELFLG=0
- . . ; Delete all assignments and change 'Prod Rpt only' flag to YES
- . . I Y S IBASNUM=0 F S IBASNUM=$O(^IBE(351.73,IBCL,1,IBASNUM)) Q:'IBASNUM D S $P(^IBE(351.73,IBCL,0),"^",2)=1 W !?3,"Productivity Report Only? changed to 'YES'..." L -^IBE(351.73,IBCL)
- . . . S DA(1)=IBCL,DA=IBASNUM,DIK="^IBE(351.73,"_DA(1)_",1," D ^DIK
- . . . K DA,DIK
- . . . W !?3,"Assignment # "_IBASNUM_" deleted..."
- Q
- ASSIGN ; Start editing assignments
- ;
- ; - Build assignment array for display
- S IBASNUM=0,IBNEWASN=1 K IBPRONLY,IBAS
- N IBBCAT,IBMBAL,IBSUP,IBFOTP,IBLBY,IBERC
- F S IBASNUM=$O(^IBE(351.73,IBCL,1,IBASNUM)) Q:'IBASNUM D
- . S IBASDA0=$G(^IBE(351.73,IBCL,1,IBASNUM,0)),IBBCAT=$P(IBASDA0,"^",2)
- . S IBMBAL=$P(IBASDA0,"^",3),IBSUP=$P(IBASDA0,"^",4)
- . S IBERC=$P(IBASDA0,"^",5)
- . S IBFOTP=$$CATTYP^IBJD1(IBBCAT)
- . I IBFOTP="F" S IBASDA1=$G(^IBE(351.73,IBCL,1,IBASNUM,1)) D
- . . S IBLBY=$S($P(IBASDA1,"^",1)'="":"LAST PMT",1:"")
- . . S IBLBY=IBLBY_$S(($P(IBASDA1,"^",2)="")&($P(IBASDA1,"^",3)=""):"",IBLBY="":"NAME",1:"/NAME")
- . . S IBLBY=IBLBY_$S(($P(IBASDA1,"^",4)="")&($P(IBASDA1,"^",5)=""):"",IBLBY="":"SSN",1:"/SSN")
- . I IBFOTP="T" S IBASDA2=$G(^IBE(351.73,IBCL,1,IBASNUM,2)) D
- . . S IBLBY=$S($P(IBASDA2,"^",1)'="":"LAST TRX",1:"")
- . . S IBLBY=IBLBY_$S($P(IBASDA2,"^",8)="":"",IBLBY="":"REC.TYPE",1:"/REC.TYPE")
- . . S IBLBY=IBLBY_$S(($P(IBASDA2,"^",2)="")&($P(IBASDA2,"^",3)=""):"",IBLBY="":"CARRIER",1:"/CARRIER")
- . . S IBLBY=IBLBY_$S(($P(IBASDA2,"^",4)="")&($P(IBASDA2,"^",5)=""):"",IBLBY="":"NAME",1:"/NAME")
- . . S IBLBY=IBLBY_$S(($P(IBASDA2,"^",6)="")&($P(IBASDA2,"^",7)=""):"",IBLBY="":"SSN",1:"/SSN")
- . S IBAS(IBASNUM)=$P($G(^PRCA(430.2,IBBCAT,0)),"^",1)_"^"
- . S IBAS(IBASNUM)=IBAS(IBASNUM)_IBMBAL_"^"_$P($G(^VA(200,+IBSUP,0)),"^",1)_"^"
- . S IBAS(IBASNUM)=IBAS(IBASNUM)_IBLBY_"^"_IBERC
- ;
- ; - Display assignment array
- S IBJOB="" N IBASDAT
- I '$D(IBAS) S IBJOB="A" Q
- S IBASNUM=0
- W !,?38,"EXCLUDE REFER"
- W !,"ASSIGNMENT",?12,"CATEGORY",?26,"MIN BALANCE",?38,"TO REG COUNSEL"
- W ?53,"LIMITED BY CARRIER/NAME/SSN"
- F S IBASNUM=$O(IBAS(IBASNUM)) Q:'IBASNUM D
- . S IBASDAT=IBAS(IBASNUM) W !,?4,IBASNUM,?12,$E($P(IBASDAT,"^",1),1,13)
- . W ?26,$J($FN($P(IBASDAT,"^",2),",",2),10)
- . W ?43,$S($P(IBASDAT,"^",5)=0:"NO",1:"YES")
- . W ?53,$E($P(IBASDAT,"^",4),1,26)
- . S IBNEWASN=IBASNUM+1
- W !
- S DIR("A")="(A)dd, (E)dit, or (D)elete Assignment"
- S DIR(0)="SB^A:ADD;E:EDIT;D:DELETE" D ^DIR K DIR
- I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 L -^IBE(351.73,IBCL) Q
- K DIROUT,DTOUT,DUOUT,DIRUN
- S IBJOB=Y
- ;
- Q
- ;
- ADD ; - Add new assignments to clerk
- ;
- N IBBCAT,IBFOTP
- W !?3,"Adding new assignment - # "_IBNEWASN_" - for "_$P(^VA(200,IBCL,0),"^",1)
- S DA(1)=IBCL,DIC="^IBE(351.73,"_DA(1)_",1,",DIC(0)="EML",DLAYGO=351.731
- S (DA,DINUM,X)=IBNEWASN
- D FILE^DICN I Y=-1 K DIC,DA Q
- K DLAYGO,DINUM,DIC(0)
- S DIC(0)="QEAM",DIC="^PRCA(430.2,"
- S DIC("S")="I $$CATTYP^IBJD1(+Y)]"""""
- D ^DIC K DIC I ($D(DTOUT))!($D(DUOUT))!(Y'>0) D S IBQUIT=1 Q
- . S DA(1)=IBCL,DA=IBNEWASN,DIK="^IBE(351.73,"_DA(1)_",1,"
- . D ^DIK K DIK,DA,DTOUT,DUOUT,Y
- . L -^IBE(351.73,IBCL)
- S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,"
- S (DA,IBASNNUM)=IBNEWASN
- S DR=".02////"_+Y_";.04////"_DUZ D ^DIE K DIE,DA,DR
- S IBBCAT=$P($G(^IBE(351.73,IBCL,1,IBNEWASN,0)),"^",2)
- S IBFOTP=$$CATTYP^IBJD1(IBBCAT)
- G EDIT1^IBJDF8I1
- ;
- Q
- ;
- DELETE ; - Delete assignment
- ;
- N DIR
- S DIR("A")="Choose a valid Assignment Number to delete",DIR(0)="N"
- D ^DIR K DIR
- I ($D(DTOUT))!($D(DUOUT)) L -^IBE(351.73,IBCL) S IBQUIT=1 K DTOUT,DUOUT Q
- I '$D(^IBE(351.73,IBCL,1,Y)) W !?3,"Not a valid assignment number" G DELETE
- S IBASNNUM=+Y
- S DA(1)=IBCL,DA=IBASNNUM,DIK="^IBE(351.73,"_DA(1)_",1,"
- D ^DIK K DA,DIK
- W !,?3,"Assignment #"_IBASNNUM_" deleted..."
- I '$O(^IBE(351.73,IBCL,1,0)) D
- . S $P(^IBE(351.73,IBCL,0),"^",2)=1
- . W !,?3,"No more valid assignments on file for this clerk. Changing the 'Productivity Report Only' flag to Yes."
- Q
- ;
- EXIT ; - Exit routine
- I IBCL L -^IBE(351.73,IBCL)
- K IBPRONLY,IBQUIT,IBCL,IBASNUM,IBNEWASN,IBASDA0,IBBCAT,IBMBAL,IBSUP
- K IBFOTP,IBASDA1,IBASDA2,IBLBY,IBAS,IBJOB,IBASDAT,IBASNNUM,IBSNF,IBSNL
- K IBSN,IBFPDATA,IBTPDATA,IBSDEF,IBTDEF,IBOFF,IBBTYP,IBCATDA0,IBDA0
- K IBRTDEF
- K DIE,DA,DIR,DR,DUOUT,DTOUT,Y,X,DIK,DINUM,DLAYGO,DIC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDF8I 6341 printed Apr 23, 2025@18:37:44 Page 2
- IBJDF8I ;ALB/RRG-ADD/EDIT IB DM WORKLOAD PARAMETERS ;11/06/00
- +1 ;;2.0;INTEGRATED BILLING;**123,604**;21-MAR-94;Build 11
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- START DO BEG
- if IBQUIT
- GOTO EXIT
- IF IBPRONLY
- GOTO START
- +1 DO ASSIGN
- if IBQUIT
- GOTO START
- +2 IF IBJOB="A"
- DO ADD
- if IBQUIT
- GOTO START
- +3 IF IBJOB="E"
- DO EDIT^IBJDF8I1
- if IBQUIT
- GOTO START
- +4 IF IBJOB="D"
- DO DELETE
- if IBQUIT
- GOTO START
- +5 LOCK -^IBE(351.73,IBCL)
- +6 GOTO START
- +7 QUIT
- +8 ;
- BEG ;Start editing workload paramters
- +1 NEW DIC,IBDELFLG
- SET (IBQUIT,IBPRONLY)=0
- SET (IBDA0,IBCL)=""
- SET IBDELFLG=1
- +2 ;S DIC="^IBE(351.73,",DIC(0)="QEAML",DLAYGO=351.73,DIC("A")="Select Clerk: " ; IB*2.0*604 - original code
- +3 ; *604-Search NEW PERSON (#200) file for clerk
- SET DIC="^VA(200,"
- SET DIC(0)="QEAMV"
- SET DIC("A")="Select Clerk: "
- +4 DO ^DIC
- IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y'>0)
- SET IBQUIT=1
- QUIT
- +5 ; *604-Use IEN of entry found in file #200 to search file #351.73
- +6 ; If no match is found in #351.73, allow a new entry to be made using the existing entry in #200
- +7 ; *604
- SET X=+Y
- SET DIC="^IBE(351.73,"
- SET DIC(0)="QELUX"
- SET DLAYGO=351.73
- +8 ; *604
- DO ^DIC
- IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y'>0)
- SET IBQUIT=1
- QUIT
- +9 SET IBCL=+Y
- WRITE !
- +10 LOCK +^IBE(351.73,IBCL):2
- IF '$TEST
- WRITE !?3,"Another user is editing this entry."
- GOTO BEG
- +11 IF $PIECE(^IBE(351.73,IBCL,0),"^",3)=""
- Begin DoDot:1
- +12 SET DIE=DIC
- SET DR=".03////"_DUZ
- SET DA=IBCL
- DO ^DIE
- KILL DIE,DR,DA
- End DoDot:1
- PRONLY SET DIR(0)="351.73,.02"
- SET DA=IBCL
- SET IBDELFLG=1
- +1 DO ^DIR
- KILL DIR
- IF ($DATA(DTOUT))!($DATA(DUOUT))
- LOCK -^IBE(351.73,IBCL)
- GOTO BEG
- +2 SET IBPRONLY=Y
- KILL DIROUT,DTOUT,DUOUT
- +3 IF 'IBPRONLY
- SET $PIECE(^IBE(351.73,IBCL,0),"^",2)=0
- QUIT
- +4 IF IBPRONLY
- Begin DoDot:1
- +5 IF $ORDER(^IBE(351.73,IBCL,1,0))
- Begin DoDot:2
- +6 SET DIR(0)="Y"
- SET DIR("B")="NO"
- +7 SET DIR("A",1)="There are existing assignments for this clerk."
- +8 SET DIR("A",2)="Those assignments must be deleted before the 'Productivity Report Only'"
- +9 SET DIR("A",3)=" flag can be changed to 'Yes'."
- +10 SET DIR("A")="Do you want to delete the existing assignments now"
- +11 DO ^DIR
- KILL DIR
- IF ($DATA(DTOUT))!($DATA(DUOUT))
- LOCK -^IBE(351.73,IBCL)
- SET IBQUIT=1
- QUIT
- +12 KILL DIROUT,DTOUT,DUOUT
- IF 'Y
- SET IBDELFLG=0
- +13 ; Delete all assignments and change 'Prod Rpt only' flag to YES
- +14 IF Y
- SET IBASNUM=0
- FOR
- SET IBASNUM=$ORDER(^IBE(351.73,IBCL,1,IBASNUM))
- if 'IBASNUM
- QUIT
- Begin DoDot:3
- +15 SET DA(1)=IBCL
- SET DA=IBASNUM
- SET DIK="^IBE(351.73,"_DA(1)_",1,"
- DO ^DIK
- +16 KILL DA,DIK
- +17 WRITE !?3,"Assignment # "_IBASNUM_" deleted..."
- End DoDot:3
- SET $PIECE(^IBE(351.73,IBCL,0),"^",2)=1
- WRITE !?3,"Productivity Report Only? changed to 'YES'..."
- LOCK -^IBE(351.73,IBCL)
- End DoDot:2
- End DoDot:1
- if IBQUIT
- QUIT
- IF 'IBDELFLG
- GOTO PRONLY
- +18 QUIT
- ASSIGN ; Start editing assignments
- +1 ;
- +2 ; - Build assignment array for display
- +3 SET IBASNUM=0
- SET IBNEWASN=1
- KILL IBPRONLY,IBAS
- +4 NEW IBBCAT,IBMBAL,IBSUP,IBFOTP,IBLBY,IBERC
- +5 FOR
- SET IBASNUM=$ORDER(^IBE(351.73,IBCL,1,IBASNUM))
- if 'IBASNUM
- QUIT
- Begin DoDot:1
- +6 SET IBASDA0=$GET(^IBE(351.73,IBCL,1,IBASNUM,0))
- SET IBBCAT=$PIECE(IBASDA0,"^",2)
- +7 SET IBMBAL=$PIECE(IBASDA0,"^",3)
- SET IBSUP=$PIECE(IBASDA0,"^",4)
- +8 SET IBERC=$PIECE(IBASDA0,"^",5)
- +9 SET IBFOTP=$$CATTYP^IBJD1(IBBCAT)
- +10 IF IBFOTP="F"
- SET IBASDA1=$GET(^IBE(351.73,IBCL,1,IBASNUM,1))
- Begin DoDot:2
- +11 SET IBLBY=$SELECT($PIECE(IBASDA1,"^",1)'="":"LAST PMT",1:"")
- +12 SET IBLBY=IBLBY_$SELECT(($PIECE(IBASDA1,"^",2)="")&($PIECE(IBASDA1,"^",3)=""):"",IBLBY="":"NAME",1:"/NAME")
- +13 SET IBLBY=IBLBY_$SELECT(($PIECE(IBASDA1,"^",4)="")&($PIECE(IBASDA1,"^",5)=""):"",IBLBY="":"SSN",1:"/SSN")
- End DoDot:2
- +14 IF IBFOTP="T"
- SET IBASDA2=$GET(^IBE(351.73,IBCL,1,IBASNUM,2))
- Begin DoDot:2
- +15 SET IBLBY=$SELECT($PIECE(IBASDA2,"^",1)'="":"LAST TRX",1:"")
- +16 SET IBLBY=IBLBY_$SELECT($PIECE(IBASDA2,"^",8)="":"",IBLBY="":"REC.TYPE",1:"/REC.TYPE")
- +17 SET IBLBY=IBLBY_$SELECT(($PIECE(IBASDA2,"^",2)="")&($PIECE(IBASDA2,"^",3)=""):"",IBLBY="":"CARRIER",1:"/CARRIER")
- +18 SET IBLBY=IBLBY_$SELECT(($PIECE(IBASDA2,"^",4)="")&($PIECE(IBASDA2,"^",5)=""):"",IBLBY="":"NAME",1:"/NAME")
- +19 SET IBLBY=IBLBY_$SELECT(($PIECE(IBASDA2,"^",6)="")&($PIECE(IBASDA2,"^",7)=""):"",IBLBY="":"SSN",1:"/SSN")
- End DoDot:2
- +20 SET IBAS(IBASNUM)=$PIECE($GET(^PRCA(430.2,IBBCAT,0)),"^",1)_"^"
- +21 SET IBAS(IBASNUM)=IBAS(IBASNUM)_IBMBAL_"^"_$PIECE($GET(^VA(200,+IBSUP,0)),"^",1)_"^"
- +22 SET IBAS(IBASNUM)=IBAS(IBASNUM)_IBLBY_"^"_IBERC
- End DoDot:1
- +23 ;
- +24 ; - Display assignment array
- +25 SET IBJOB=""
- NEW IBASDAT
- +26 IF '$DATA(IBAS)
- SET IBJOB="A"
- QUIT
- +27 SET IBASNUM=0
- +28 WRITE !,?38,"EXCLUDE REFER"
- +29 WRITE !,"ASSIGNMENT",?12,"CATEGORY",?26,"MIN BALANCE",?38,"TO REG COUNSEL"
- +30 WRITE ?53,"LIMITED BY CARRIER/NAME/SSN"
- +31 FOR
- SET IBASNUM=$ORDER(IBAS(IBASNUM))
- if 'IBASNUM
- QUIT
- Begin DoDot:1
- +32 SET IBASDAT=IBAS(IBASNUM)
- WRITE !,?4,IBASNUM,?12,$EXTRACT($PIECE(IBASDAT,"^",1),1,13)
- +33 WRITE ?26,$JUSTIFY($FNUMBER($PIECE(IBASDAT,"^",2),",",2),10)
- +34 WRITE ?43,$SELECT($PIECE(IBASDAT,"^",5)=0:"NO",1:"YES")
- +35 WRITE ?53,$EXTRACT($PIECE(IBASDAT,"^",4),1,26)
- +36 SET IBNEWASN=IBASNUM+1
- End DoDot:1
- +37 WRITE !
- +38 SET DIR("A")="(A)dd, (E)dit, or (D)elete Assignment"
- +39 SET DIR(0)="SB^A:ADD;E:EDIT;D:DELETE"
- DO ^DIR
- KILL DIR
- +40 IF ($DATA(DTOUT))!($DATA(DUOUT))
- SET IBQUIT=1
- LOCK -^IBE(351.73,IBCL)
- QUIT
- +41 KILL DIROUT,DTOUT,DUOUT,DIRUN
- +42 SET IBJOB=Y
- +43 ;
- +44 QUIT
- +45 ;
- ADD ; - Add new assignments to clerk
- +1 ;
- +2 NEW IBBCAT,IBFOTP
- +3 WRITE !?3,"Adding new assignment - # "_IBNEWASN_" - for "_$PIECE(^VA(200,IBCL,0),"^",1)
- +4 SET DA(1)=IBCL
- SET DIC="^IBE(351.73,"_DA(1)_",1,"
- SET DIC(0)="EML"
- SET DLAYGO=351.731
- +5 SET (DA,DINUM,X)=IBNEWASN
- +6 DO FILE^DICN
- IF Y=-1
- KILL DIC,DA
- QUIT
- +7 KILL DLAYGO,DINUM,DIC(0)
- +8 SET DIC(0)="QEAM"
- SET DIC="^PRCA(430.2,"
- +9 SET DIC("S")="I $$CATTYP^IBJD1(+Y)]"""""
- +10 DO ^DIC
- KILL DIC
- IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y'>0)
- Begin DoDot:1
- +11 SET DA(1)=IBCL
- SET DA=IBNEWASN
- SET DIK="^IBE(351.73,"_DA(1)_",1,"
- +12 DO ^DIK
- KILL DIK,DA,DTOUT,DUOUT,Y
- +13 LOCK -^IBE(351.73,IBCL)
- End DoDot:1
- SET IBQUIT=1
- QUIT
- +14 SET DA(1)=IBCL
- SET DIE="^IBE(351.73,"_DA(1)_",1,"
- +15 SET (DA,IBASNNUM)=IBNEWASN
- +16 SET DR=".02////"_+Y_";.04////"_DUZ
- DO ^DIE
- KILL DIE,DA,DR
- +17 SET IBBCAT=$PIECE($GET(^IBE(351.73,IBCL,1,IBNEWASN,0)),"^",2)
- +18 SET IBFOTP=$$CATTYP^IBJD1(IBBCAT)
- +19 GOTO EDIT1^IBJDF8I1
- +20 ;
- +21 QUIT
- +22 ;
- DELETE ; - Delete assignment
- +1 ;
- +2 NEW DIR
- +3 SET DIR("A")="Choose a valid Assignment Number to delete"
- SET DIR(0)="N"
- +4 DO ^DIR
- KILL DIR
- +5 IF ($DATA(DTOUT))!($DATA(DUOUT))
- LOCK -^IBE(351.73,IBCL)
- SET IBQUIT=1
- KILL DTOUT,DUOUT
- QUIT
- +6 IF '$DATA(^IBE(351.73,IBCL,1,Y))
- WRITE !?3,"Not a valid assignment number"
- GOTO DELETE
- +7 SET IBASNNUM=+Y
- +8 SET DA(1)=IBCL
- SET DA=IBASNNUM
- SET DIK="^IBE(351.73,"_DA(1)_",1,"
- +9 DO ^DIK
- KILL DA,DIK
- +10 WRITE !,?3,"Assignment #"_IBASNNUM_" deleted..."
- +11 IF '$ORDER(^IBE(351.73,IBCL,1,0))
- Begin DoDot:1
- +12 SET $PIECE(^IBE(351.73,IBCL,0),"^",2)=1
- +13 WRITE !,?3,"No more valid assignments on file for this clerk. Changing the 'Productivity Report Only' flag to Yes."
- End DoDot:1
- +14 QUIT
- +15 ;
- EXIT ; - Exit routine
- +1 IF IBCL
- LOCK -^IBE(351.73,IBCL)
- +2 KILL IBPRONLY,IBQUIT,IBCL,IBASNUM,IBNEWASN,IBASDA0,IBBCAT,IBMBAL,IBSUP
- +3 KILL IBFOTP,IBASDA1,IBASDA2,IBLBY,IBAS,IBJOB,IBASDAT,IBASNNUM,IBSNF,IBSNL
- +4 KILL IBSN,IBFPDATA,IBTPDATA,IBSDEF,IBTDEF,IBOFF,IBBTYP,IBCATDA0,IBDA0
- +5 KILL IBRTDEF
- +6 KILL DIE,DA,DIR,DR,DUOUT,DTOUT,Y,X,DIK,DINUM,DLAYGO,DIC
- +7 QUIT
