| [613] | 1 | ACKQUTL9 ;AUG/JLTP BIR/PTD HCIOFO/BH-New Clinic Visits - CONTINUED ; [ 04/12/96 10:38 AM ]
|
|---|
| 2 | ;;3.0;QUASAR;**1,4**;Feb 11, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | BUILD() ; Generate a message informing Supervisors that time period for
|
|---|
| 6 | ; for changing Procedure code type has begun
|
|---|
| 7 | ;
|
|---|
| 8 | N XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X
|
|---|
| 9 | S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP Procedure Code Amendment Notice"
|
|---|
| 10 | S TXT(1,0)=" "
|
|---|
| 11 | S TXT(2,0)=" This notice is to inform all Quasar Supervisors that the "
|
|---|
| 12 | S TXT(3,0)=" oppotunity of change the type of Procedures your Site uses"
|
|---|
| 13 | S TXT(4,0)=" is now available. This option will only be available until"
|
|---|
| 14 | S TXT(5,0)=" the 30th of September. If you wish to change the type of"
|
|---|
| 15 | S TXT(6,0)=" Procedure codes your Site uses select Quasars Site Parameters "
|
|---|
| 16 | S TXT(7,0)=" option and amend the USE EVENT CAPTURE CODES field."
|
|---|
| 17 | S TXT(8,0)=" "
|
|---|
| 18 | D STAFF,^XMD
|
|---|
| 19 | ;
|
|---|
| 20 | N ACKY
|
|---|
| 21 | S ZTDESC="QUASAR - Mail Procedure code Warning"
|
|---|
| 22 | D NOW^%DTC
|
|---|
| 23 | S ACKY=$E(X,1,3)
|
|---|
| 24 | S ACKY=ACKY+1
|
|---|
| 25 | S ZTDTH=ACKY_"0917.0100"
|
|---|
| 26 | S ZTIO=""
|
|---|
| 27 | S ZTRTN="BUILD^ACKQUTL9()"
|
|---|
| 28 | D ^%ZTLOAD
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | CHANGE(ACKQQCH,ACKDA1) ; Passes in new changed value of USE EVENT CAPTURE CODE
|
|---|
| 32 | ; field ACKQQCH will either equal '1' or zero
|
|---|
| 33 | ;
|
|---|
| 34 | N %X,DC,D2,DE,DH,DG,DI,DICREC,DIDATA,DIEDA,DIEFDAS,DIEFCNOD,DIEFAR
|
|---|
| 35 | ; N DIENCNT,DIEFF,DIEFFLAG,DIEFFLD,DIEFFLST,DIEFFREF,DIEFFVAL,DIEFI
|
|---|
| 36 | N DIEFIEN,DIFM,DIIENS,DI0V,DIP,DIEL,DITMP,DIFLD,DIEFNVAL,DIEFNODE
|
|---|
| 37 | ; N DIEFLEV,DIETMP,DIEXREF,DIEFSPOT,DIEFTREF,DIEFSORK,DIEFRLST,DIEFRFLD
|
|---|
| 38 | ; N DIEFOVAL
|
|---|
| 39 | N DA,D,D0,D1,DIE,DIC,DR,DU,XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X,Z,Y
|
|---|
| 40 | ; N DK,DQ,DP,DQI,XQZ,X1,J,M,S,POP,DV,DW,XQXFLG,XQW,XQV,XQUSER,XQSV,XQT
|
|---|
| 41 | ; N XQJMP,XQCH,DOREPL,DN,DM,DLAYGO,DL,DIQUIET,DIWT,DIW,DIENS
|
|---|
| 42 | N ACKDIVN S ACKDIVN=$$GET1^DIQ(40.8,ACKDA1,.01)
|
|---|
| 43 | S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP Procedure Code Change Notice."
|
|---|
| 44 | S TXT(1,0)=" "
|
|---|
| 45 | S TXT(2,0)=" The USE EVENT CAPTURE CODE field has been amened within "
|
|---|
| 46 | S TXT(3,0)=" Quasars Site Parameters function."
|
|---|
| 47 | S TXT(4,0)=" Division "_ACKDIVN_" is now set up to use "_$S(ACKQQCH=1:"Event Capture",1:"CPT")_" codes."
|
|---|
| 48 | S TXT(5,0)=" This change will take effect on the 1st of October."
|
|---|
| 49 | S TXT(6,0)=" "
|
|---|
| 50 | D STAFF,^XMD
|
|---|
| 51 | K ACKDA1
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | STAFF ; Create XMY(... array using active supervisors from A&SP STAFF file
|
|---|
| 55 | N ACKQQCNV,X,Y,ACKST,ACKIND,ACKDTE S ACKST=0
|
|---|
| 56 | D NOW^%DTC ; X=TODAYS DATE
|
|---|
| 57 | S ACKDTE=X
|
|---|
| 58 | F S ACKST=$O(^ACK(509850.3,ACKST)) Q:'ACKST D
|
|---|
| 59 | . I $P(^ACK(509850.3,ACKST,0),U,6)'=1 Q ; Not a Supervisor
|
|---|
| 60 | . S ACKIND=$P(^ACK(509850.3,ACKST,0),U,4)
|
|---|
| 61 | . I ACKIND'="",ACKIND<ACKDTE Q ; Inactivated
|
|---|
| 62 | . S ACKQQCNV=$$CONVERT2^ACKQUTL4(ACKST) I ACKQQCNV="" Q
|
|---|
| 63 | . S XMY(ACKQQCNV)=""
|
|---|
| 64 | S XMY(DUZ)=""
|
|---|
| 65 | I '$O(XMY(0)) S XMY(.5)=""
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | CHECK() ; Check to see if 2 week time time window to edit USE EC CODE
|
|---|
| 69 | ; is now
|
|---|
| 70 | ;
|
|---|
| 71 | D NOW^%DTC
|
|---|
| 72 | N ACKM,ACKD
|
|---|
| 73 | S ACKM=$E(X,4,5)
|
|---|
| 74 | S ACKD=$E(X,6,7)
|
|---|
| 75 | I ACKM'="09" Q 0
|
|---|
| 76 | I ACKD>16 Q 1
|
|---|
| 77 | Q 0
|
|---|
