- RCDMBWL2 ;WISC/RFJ-diagnostic measures workload report (to super) ;1 Jan 01
- ;;4.5;Accounts Receivable;**167,197**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- REPORT ; called by RCDMBWLR to generate the report
- N %,DATA,RCASSIGN,RCCLERK,RCCOUNT,RCDATA,RCDESC,RCLINE,RCTMPDAT,RCTODAY,X,XMDUN,XMY,XMZ,Y,IBHOLDER
- D NOW^%DTC S Y=X D DD^%DT S RCTODAY=Y,RCTODAY=$$DOW^XLFDT(X)_" "_RCTODAY
- ;
- ; initialize counts for summary of all assignments
- S RCCOUNT("allbills")=0
- S RCCOUNT("allbillstotal")=0
- ;
- ; generate mailmessage to each supervisor
- ; show heading at top of mailman message
- K ^TMP($J,"RCRJRCORMM")
- ; don't send supervisor message if no to-do lists generated
- I '$D(^TMP("RCDMBWL1",$J)) Q
- S RCLINE=0
- D BUILDMM("The following mailman message is your Accounts Receivable supervisor list.")
- D BUILDMM(" "_RCTODAY_".")
- D BUILDMM(" ")
- ;
- S RCCLERK("name")="" F S RCCLERK("name")=$O(^TMP("RCDMBWL1",$J,RCCLERK("name"))) Q:RCCLERK("name")="" D
- . S RCCLERK=0 F S RCCLERK=$O(^TMP("RCDMBWL1",$J,RCCLERK("name"),RCCLERK)) Q:'RCCLERK D
- . . S RCASSIGN=0 F S RCASSIGN=$O(^TMP("RCDMBWL1",$J,RCCLERK("name"),RCCLERK,RCASSIGN)) Q:'RCASSIGN D
- . . . S RCTMPDAT=^TMP("RCDMBWL1",$J,RCCLERK("name"),RCCLERK,RCASSIGN,"SUMM")
- . . . D BUILDMM(" ")
- . . . D BUILDMM("CLERK: "_$E(RCCLERK("name")_" ",1,20)_" ASSIGN #: "_$E(RCASSIGN_" ",1,5)_"COUNT: "_$J($P(RCTMPDAT,"^"),6)_" TOTAL: "_$J($P(RCTMPDAT,"^",2),10,2))
- . . . ; show the condition of the assignment
- . . . S RCDATA=" CONDITION: IF "
- . . . ; print conditions [condition 1][condition 2][...]
- . . . S RCDESC=^TMP("RCDMBWL1",$J,RCCLERK("name"),RCCLERK,RCASSIGN,"DESC")
- . . . F %=2:1 D I DATA="" Q
- . . . . S DATA=$P($P(RCDESC,"[",%),"]")
- . . . . I DATA="" Q
- . . . . D BUILDMM($S(RCDATA'="":RCDATA,1:" and ")_DATA)
- . . . . ; do not show "condition: if" more than once
- . . . . S RCDATA=""
- . . . ;
- . . . ; total all bills
- . . . S RCCOUNT("allbills")=RCCOUNT("allbills")+$P(RCTMPDAT,"^")
- . . . S RCCOUNT("allbillstotal")=RCCOUNT("allbillstotal")+$P(RCTMPDAT,"^",2)
- ;
- ; show bill count for all clerks
- D BUILDMM(" ")
- D BUILDMM("TOTAL BILL COUNT FOR ALL CLERKS: "_RCCOUNT("allbills"))
- D BUILDMM("TOTAL BILL DOLLARS FOR ALL CLERKS: "_$J(RCCOUNT("allbillstotal"),0,2))
- ;
- ; send mail message ; extrinsic function needs to be outside the
- ; dot structure so that only 1 mailman message is generated and
- ; sent to all recipients of the IBJD Workload Assignment key.
- S IBHOLDER=0 F S IBHOLDER=$O(^XUSEC("IBJD WORKLOAD ASSIGNMENT",IBHOLDER)) Q:'IBHOLDER D
- . S XMY(IBHOLDER)=""
- S XMZ=$$SENDMSG^RCRJRCOR("AR Supervisor List for "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),.XMY)
- K ^TMP($J,"RCRJRCORMM")
- Q
- ;
- ;
- BUILDMM(DATA) ; build mailman message
- S RCLINE=RCLINE+1
- S ^TMP($J,"RCRJRCORMM",RCLINE)=DATA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMBWL2 3080 printed Jan 18, 2025@02:44:36 Page 2
- RCDMBWL2 ;WISC/RFJ-diagnostic measures workload report (to super) ;1 Jan 01
- +1 ;;4.5;Accounts Receivable;**167,197**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- REPORT ; called by RCDMBWLR to generate the report
- +1 NEW %,DATA,RCASSIGN,RCCLERK,RCCOUNT,RCDATA,RCDESC,RCLINE,RCTMPDAT,RCTODAY,X,XMDUN,XMY,XMZ,Y,IBHOLDER
- +2 DO NOW^%DTC
- SET Y=X
- DO DD^%DT
- SET RCTODAY=Y
- SET RCTODAY=$$DOW^XLFDT(X)_" "_RCTODAY
- +3 ;
- +4 ; initialize counts for summary of all assignments
- +5 SET RCCOUNT("allbills")=0
- +6 SET RCCOUNT("allbillstotal")=0
- +7 ;
- +8 ; generate mailmessage to each supervisor
- +9 ; show heading at top of mailman message
- +10 KILL ^TMP($JOB,"RCRJRCORMM")
- +11 ; don't send supervisor message if no to-do lists generated
- +12 IF '$DATA(^TMP("RCDMBWL1",$JOB))
- QUIT
- +13 SET RCLINE=0
- +14 DO BUILDMM("The following mailman message is your Accounts Receivable supervisor list.")
- +15 DO BUILDMM(" "_RCTODAY_".")
- +16 DO BUILDMM(" ")
- +17 ;
- +18 SET RCCLERK("name")=""
- FOR
- SET RCCLERK("name")=$ORDER(^TMP("RCDMBWL1",$JOB,RCCLERK("name")))
- if RCCLERK("name")=""
- QUIT
- Begin DoDot:1
- +19 SET RCCLERK=0
- FOR
- SET RCCLERK=$ORDER(^TMP("RCDMBWL1",$JOB,RCCLERK("name"),RCCLERK))
- if 'RCCLERK
- QUIT
- Begin DoDot:2
- +20 SET RCASSIGN=0
- FOR
- SET RCASSIGN=$ORDER(^TMP("RCDMBWL1",$JOB,RCCLERK("name"),RCCLERK,RCASSIGN))
- if 'RCASSIGN
- QUIT
- Begin DoDot:3
- +21 SET RCTMPDAT=^TMP("RCDMBWL1",$JOB,RCCLERK("name"),RCCLERK,RCASSIGN,"SUMM")
- +22 DO BUILDMM(" ")
- +23 DO BUILDMM("CLERK: "_$EXTRACT(RCCLERK("name")_" ",1,20)_" ASSIGN #: "_$EXTRACT(RCASSIGN_" ",1,5)_"COUNT: "_$JUSTIFY($PIECE(RCTMPDAT,"^"),6)_" TOTAL: "_$JUSTIFY($PIECE(RCTMPDAT,"^",2),10,2))
- +24 ; show the condition of the assignment
- +25 SET RCDATA=" CONDITION: IF "
- +26 ; print conditions [condition 1][condition 2][...]
- +27 SET RCDESC=^TMP("RCDMBWL1",$JOB,RCCLERK("name"),RCCLERK,RCASSIGN,"DESC")
- +28 FOR %=2:1
- Begin DoDot:4
- +29 SET DATA=$PIECE($PIECE(RCDESC,"[",%),"]")
- +30 IF DATA=""
- QUIT
- +31 DO BUILDMM($SELECT(RCDATA'="":RCDATA,1:" and ")_DATA)
- +32 ; do not show "condition: if" more than once
- +33 SET RCDATA=""
- End DoDot:4
- IF DATA=""
- QUIT
- +34 ;
- +35 ; total all bills
- +36 SET RCCOUNT("allbills")=RCCOUNT("allbills")+$PIECE(RCTMPDAT,"^")
- +37 SET RCCOUNT("allbillstotal")=RCCOUNT("allbillstotal")+$PIECE(RCTMPDAT,"^",2)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +38 ;
- +39 ; show bill count for all clerks
- +40 DO BUILDMM(" ")
- +41 DO BUILDMM("TOTAL BILL COUNT FOR ALL CLERKS: "_RCCOUNT("allbills"))
- +42 DO BUILDMM("TOTAL BILL DOLLARS FOR ALL CLERKS: "_$JUSTIFY(RCCOUNT("allbillstotal"),0,2))
- +43 ;
- +44 ; send mail message ; extrinsic function needs to be outside the
- +45 ; dot structure so that only 1 mailman message is generated and
- +46 ; sent to all recipients of the IBJD Workload Assignment key.
- +47 SET IBHOLDER=0
- FOR
- SET IBHOLDER=$ORDER(^XUSEC("IBJD WORKLOAD ASSIGNMENT",IBHOLDER))
- if 'IBHOLDER
- QUIT
- Begin DoDot:1
- +48 SET XMY(IBHOLDER)=""
- End DoDot:1
- +49 SET XMZ=$$SENDMSG^RCRJRCOR("AR Supervisor List for "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),.XMY)
- +50 KILL ^TMP($JOB,"RCRJRCORMM")
- +51 QUIT
- +52 ;
- +53 ;
- BUILDMM(DATA) ; build mailman message
- +1 SET RCLINE=RCLINE+1
- +2 SET ^TMP($JOB,"RCRJRCORMM",RCLINE)=DATA
- +3 QUIT