- 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 Feb 18, 2025@23:58:36 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 ;
