| [613] | 1 | ACKQDWB ;AUG/JLTP BIR/PTD HCIOFO/BH-Compile A&SP Capitation Data - CONTINUED ; [ 12/05/95 10:33 ]
|
|---|
| 2 | ;;3.0;QUASAR;;Feb 11, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | BUILD ; Capitation report has been generated.
|
|---|
| 6 | N XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X
|
|---|
| 7 | S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP CAPITATION DATA GENERATED"
|
|---|
| 8 | S TXT(1,0)="A&SP capitation data have been generated for "_ACKMO_"."
|
|---|
| 9 | S TXT(2,0)=" "
|
|---|
| 10 | D DIV1 ; Display Divisions
|
|---|
| 11 | S TXT(I,0)=""
|
|---|
| 12 | S I=I+1,TXT(I,0)=" Start Date/Time : "_ACKXSDTE_" at "_ACKXST
|
|---|
| 13 | S I=I+1,TXT(I,0)=" Finish Date/Time: "_ACKXEDTE_" at "_ACKXFT
|
|---|
| 14 | S I=I+1,TXT(I,0)=""
|
|---|
| 15 | S I=I+1,TXT(I,0)="You can use the Print A&SP Capitation Report option to check the"
|
|---|
| 16 | S I=I+1,TXT(I,0)="data for accuracy.",I=I+1,TXT(I,0)=""
|
|---|
| 17 | D STAFF,^XMD
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ABORT(ACKST) ; Abort bulletin. ACKST = reason for abort.
|
|---|
| 21 | N XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X,ACKK1
|
|---|
| 22 | S ACKK1=""
|
|---|
| 23 | S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP CAPITATION REPORT ABORTED!"
|
|---|
| 24 | ;
|
|---|
| 25 | S TXT(1,0)=" **** WARNING ****"
|
|---|
| 26 | S TXT(2,0)=" The monthly A&SP Capitation generation has terminated abnormally."
|
|---|
| 27 | ;
|
|---|
| 28 | D DIV ; Display Divisions with errors
|
|---|
| 29 | ;
|
|---|
| 30 | S TXT(I,0)="Reason: "_$P(ACKST,U,3),TXT(I+1,0)=" "
|
|---|
| 31 | S TXT(I+1,0)=" Please inform your IRM Service. Your Capitation Report"
|
|---|
| 32 | S TXT(I+1,0)="for the month can not be printed until this problem is resolved."
|
|---|
| 33 | S TXT(I+1,0)=" "
|
|---|
| 34 | D STAFF,^XMD
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | STAFF ;Create XMY( array using active supervisors from the A&SP STAFF file (#509850.3).
|
|---|
| 38 | N ST S ST=0
|
|---|
| 39 | 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))=""
|
|---|
| 40 | I $G(ACKMAN) S XMY(ACKDUZ)=""
|
|---|
| 41 | I '$O(XMY(0)) S XMY(.5)=""
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | DIV ; Loops through the Entered Divisions and displays the ones appropriate
|
|---|
| 45 | S I=3
|
|---|
| 46 | S ACKK1=""
|
|---|
| 47 | F S ACKK1=$O(ACKDIV(ACKK1)) Q:ACKK1="" D
|
|---|
| 48 | . S DIVIEN=$P(ACKDIV(ACKK1),U,1)
|
|---|
| 49 | . I '$D(^ACK(509850.7,ACKDA,5,DIVIEN)) Q
|
|---|
| 50 | . 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
|
|---|
| 51 | . I $E(ACKST)=2,$P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4) D Q
|
|---|
| 52 | . . D DIVLN S I=I+1
|
|---|
| 53 | . I $E(ACKST)=1,'$P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4) D Q
|
|---|
| 54 | . . D DIVLN S I=I+1
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | DIV1 ; Loops through all divisions and displays them
|
|---|
| 58 | S ACKK1="",I=3
|
|---|
| 59 | F S ACKK1=$O(ACKDIV(ACKK1)) Q:ACKK1="" D DIVLN S I=I+1
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | DIVLN I I=3 S TXT(3,0)=" For the following "_$S($O(ACKDIV(ACKK1))'="":"Divisions",1:"Division")_" : "_$P(ACKDIV(ACKK1),U,3) Q
|
|---|
| 63 | S TXT(I,0)=" "_$P(ACKDIV(ACKK1),U,3)
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
