ACKQDWB ;AUG/JLTP BIR/PTD HCIOFO/BH-Compile A&SP Capitation Data - CONTINUED ; [ 12/05/95 10:33 ]
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
BUILD ; Capitation report has been generated.
N XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X
S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP CAPITATION DATA GENERATED"
S TXT(1,0)="A&SP capitation data have been generated for "_ACKMO_"."
S TXT(2,0)=" "
D DIV1 ; Display Divisions
S TXT(I,0)=""
S I=I+1,TXT(I,0)=" Start Date/Time : "_ACKXSDTE_" at "_ACKXST
S I=I+1,TXT(I,0)=" Finish Date/Time: "_ACKXEDTE_" at "_ACKXFT
S I=I+1,TXT(I,0)=""
S I=I+1,TXT(I,0)="You can use the Print A&SP Capitation Report option to check the"
S I=I+1,TXT(I,0)="data for accuracy.",I=I+1,TXT(I,0)=""
D STAFF,^XMD
Q
;
ABORT(ACKST) ; Abort bulletin. ACKST = reason for abort.
N XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X,ACKK1
S ACKK1=""
S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP CAPITATION REPORT ABORTED!"
;
S TXT(1,0)=" **** WARNING ****"
S TXT(2,0)=" The monthly A&SP Capitation generation has terminated abnormally."
;
D DIV ; Display Divisions with errors
;
S TXT(I,0)="Reason: "_$P(ACKST,U,3),TXT(I+1,0)=" "
S TXT(I+1,0)=" Please inform your IRM Service. Your Capitation Report"
S TXT(I+1,0)="for the month can not be printed until this problem is resolved."
S TXT(I+1,0)=" "
D STAFF,^XMD
Q
;
STAFF ;Create XMY( array using active supervisors from the A&SP STAFF file (#509850.3).
N ST S ST=0
F S ST=$O(^ACK(509850.3,ST)) Q:'ST I $P(^ACK(509850.3,ST,0),U,6),'$P(^(0),U,4) S XMY($$CONVERT1^ACKQUTL4(ST))=""
I $G(ACKMAN) S XMY(ACKDUZ)=""
I '$O(XMY(0)) S XMY(.5)=""
Q
;
DIV ; Loops through the Entered Divisions and displays the ones appropriate
S I=3
S ACKK1=""
F S ACKK1=$O(ACKDIV(ACKK1)) Q:ACKK1="" D
. S DIVIEN=$P(ACKDIV(ACKK1),U,1)
. I '$D(^ACK(509850.7,ACKDA,5,DIVIEN)) Q
. I '$P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,2),'$P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,3),'$P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4) Q
. I $E(ACKST)=2,$P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4) D Q
. . D DIVLN S I=I+1
. I $E(ACKST)=1,'$P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4) D Q
. . D DIVLN S I=I+1
Q
;
DIV1 ; Loops through all divisions and displays them
S ACKK1="",I=3
F S ACKK1=$O(ACKDIV(ACKK1)) Q:ACKK1="" D DIVLN S I=I+1
Q
;
DIVLN I I=3 S TXT(3,0)=" For the following "_$S($O(ACKDIV(ACKK1))'="":"Divisions",1:"Division")_" : "_$P(ACKDIV(ACKK1),U,3) Q
S TXT(I,0)=" "_$P(ACKDIV(ACKK1),U,3)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQDWB 2673 printed Sep 23, 2025@20:08:27 Page 2
ACKQDWB ;AUG/JLTP BIR/PTD HCIOFO/BH-Compile A&SP Capitation Data - CONTINUED ; [ 12/05/95 10:33 ]
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
BUILD ; Capitation report has been generated.
+1 NEW XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X
+2 SET (XMDUZ,XMDUN)="QUASAR"
SET XMTEXT="TXT("
SET XMSUB="A&SP CAPITATION DATA GENERATED"
+3 SET TXT(1,0)="A&SP capitation data have been generated for "_ACKMO_"."
+4 SET TXT(2,0)=" "
+5 ; Display Divisions
DO DIV1
+6 SET TXT(I,0)=""
+7 SET I=I+1
SET TXT(I,0)=" Start Date/Time : "_ACKXSDTE_" at "_ACKXST
+8 SET I=I+1
SET TXT(I,0)=" Finish Date/Time: "_ACKXEDTE_" at "_ACKXFT
+9 SET I=I+1
SET TXT(I,0)=""
+10 SET I=I+1
SET TXT(I,0)="You can use the Print A&SP Capitation Report option to check the"
+11 SET I=I+1
SET TXT(I,0)="data for accuracy."
SET I=I+1
SET TXT(I,0)=""
+12 DO STAFF
DO ^XMD
+13 QUIT
+14 ;
ABORT(ACKST) ; Abort bulletin. ACKST = reason for abort.
+1 NEW XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X,ACKK1
+2 SET ACKK1=""
+3 SET (XMDUZ,XMDUN)="QUASAR"
SET XMTEXT="TXT("
SET XMSUB="A&SP CAPITATION REPORT ABORTED!"
+4 ;
+5 SET TXT(1,0)=" **** WARNING ****"
+6 SET TXT(2,0)=" The monthly A&SP Capitation generation has terminated abnormally."
+7 ;
+8 ; Display Divisions with errors
DO DIV
+9 ;
+10 SET TXT(I,0)="Reason: "_$PIECE(ACKST,U,3)
SET TXT(I+1,0)=" "
+11 SET TXT(I+1,0)=" Please inform your IRM Service. Your Capitation Report"
+12 SET TXT(I+1,0)="for the month can not be printed until this problem is resolved."
+13 SET TXT(I+1,0)=" "
+14 DO STAFF
DO ^XMD
+15 QUIT
+16 ;
STAFF ;Create XMY( array using active supervisors from the A&SP STAFF file (#509850.3).
+1 NEW ST
SET ST=0
+2 FOR
SET ST=$ORDER(^ACK(509850.3,ST))
if 'ST
QUIT
IF $PIECE(^ACK(509850.3,ST,0),U,6)
IF '$PIECE(^(0),U,4)
SET XMY($$CONVERT1^ACKQUTL4(ST))=""
+3 IF $GET(ACKMAN)
SET XMY(ACKDUZ)=""
+4 IF '$ORDER(XMY(0))
SET XMY(.5)=""
+5 QUIT
+6 ;
DIV ; Loops through the Entered Divisions and displays the ones appropriate
+1 SET I=3
+2 SET ACKK1=""
+3 FOR
SET ACKK1=$ORDER(ACKDIV(ACKK1))
if ACKK1=""
QUIT
Begin DoDot:1
+4 SET DIVIEN=$PIECE(ACKDIV(ACKK1),U,1)
+5 IF '$DATA(^ACK(509850.7,ACKDA,5,DIVIEN))
QUIT
+6 IF '$PIECE(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,2)
IF '$PIECE(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,3)
IF '$PIECE(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4)
QUIT
+7 IF $EXTRACT(ACKST)=2
IF $PIECE(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4)
Begin DoDot:2
+8 DO DIVLN
SET I=I+1
End DoDot:2
QUIT
+9 IF $EXTRACT(ACKST)=1
IF '$PIECE(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4)
Begin DoDot:2
+10 DO DIVLN
SET I=I+1
End DoDot:2
QUIT
End DoDot:1
+11 QUIT
+12 ;
DIV1 ; Loops through all divisions and displays them
+1 SET ACKK1=""
SET I=3
+2 FOR
SET ACKK1=$ORDER(ACKDIV(ACKK1))
if ACKK1=""
QUIT
DO DIVLN
SET I=I+1
+3 QUIT
+4 ;
DIVLN IF I=3
SET TXT(3,0)=" For the following "_$SELECT($ORDER(ACKDIV(ACKK1))'="":"Divisions",1:"Division")_" : "_$PIECE(ACKDIV(ACKK1),U,3)
QUIT
+1 SET TXT(I,0)=" "_$PIECE(ACKDIV(ACKK1),U,3)
+2 QUIT
+3 ;
