source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLSRV3.m@ 949

Last change on this file since 949 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 6.6 KB
Line 
1YSCLSRV3 ;DALOI/RLM-Clozapine data server ;24 APR 1990
2 ;;5.01;MENTAL HEALTH;**74,90**;Dec 30, 1994;Build 18
3 ; Reference to ^%ZOSF supported by IA #10096
4 ; Reference to ^DPT supported by IA #10035
5 ; Reference to ^PS(55 supported by IA #787
6 ; Reference to ^PSDRUG supported by IA #25
7 ; Reference to ^PSRX supported by IA #780
8 ; Reference to ^VA(200 supported by IA #10060
9 ; Reference to ^XUSEC supported by IA #10076
10 ;
11 S ^TMP($J,"YSCLDATA",1)="This routine will print a list of all active Clozapine prescriptions."
12 S ^TMP($J,"YSCLDATA",2)="An asterisk in the first column indicates that the prescription is over"
13 S ^TMP($J,"YSCLDATA",3)="28 days old. The second column is the Patient Name. The third is the"
14 S ^TMP($J,"YSCLDATA",4)="Issue Date. The fourth column is the Prescription Number. The final"
15 S ^TMP($J,"YSCLDATA",5)="column is the CLOZAPINE STATUS indicator."
16 S X1=DT,X2=-28 D C^%DTC S YSCL28=X
17 S DFN=0,YSCLLN=6
18 F K YSCLA S DFN=$O(^PS(55,"ASAND",DFN)),YSCLLD=0 Q:'DFN I $D(^DPT(DFN,0)),$D(^PS(55,DFN,"SAND")) S YSCLSAND=^("SAND"),YSCL=^DPT(DFN,0),YSCLX=$E($P($P(YSCL,"^"),",",2))_$E(YSCL)_"^"_$P(YSCL,"^",9) D
19 . F YSCL=0:0 S YSCL=$O(^PS(55,DFN,"P",YSCL)) Q:'YSCL I $D(^(YSCL,0)) S YSCL1=^(0) I $D(^PSRX(YSCL1,0)) D ACTIVE I 'YSACT S YSCLRX=^PSRX(YSCL1,0) I $P($G(^PSDRUG(+$P(YSCLRX,"^",6),"CLOZ1")),"^")="PSOCLO1",$D(^("CLOZ")) S YSCLLAB=^("CLOZ") D
20 . . ;W !,DFN," - ",YSCL1
21 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$S(YSCL28>$P(YSCLRX,"^",13):"*",1:" ")_"^"_$P(^DPT($P(YSCLRX,"^",2),0),"^")_"^"_$$FMTE^XLFDT($P(YSCLRX,"^",13))_"^"_$P(YSCLRX,"^")_"^"_$P(YSCLSAND,"^",2)
22 . . S YSCLLN=YSCLLN+1
23 G EXIT^YSCLSERV
24 Q
25ACTIVE ;
26 S YSACT=$$GET1^DIQ(52,YSCL1_",",100,"I","ERR")
27 Q
28DEMOG ;
29 S YSCLA=0 F S YSCLA=$O(^YSCL(603.01,"C",YSCLA)) Q:'YSCLA D
30 . I $D(^PS(55,YSCLA,"SAND")),$P(^PS(55,YSCLA,"SAND"),"^",4)=0 S YSCLC=$G(YSCLC)+1
31 . I $D(^PS(55,YSCLA,"SAND")),$P(^PS(55,YSCLA,"SAND"),"^",4) S $P(^PS(55,YSCLA,"SAND"),"^",4)=0,YSCLB=$G(YSCLB)+1
32 S ^TMP($J,"YSCLDATA",2)=+$G(YSCLB)_" record"_$S(+$G(YSCLB)=1:"",1:"s")_" reset at ("_YSCLST_") "_YSCLSTN
33 S ^TMP($J,"YSCLDATA",3)=+$G(YSCLC)_" record"_$S(+$G(YSCLC)=1:"",1:"s")_" not reset at ("_YSCLST_") "_YSCLSTN
34 G EXIT^YSCLSERV
35 Q
36LOCK ;Lock out ability to dispense Clozapine
37 X XMREC Q:XMER<0 S X=XMRG
38 I X="LOCK DOWN ON" S $P(^YSCL(603.03,1,1),"^",1)=1 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Clozapine dispensing prohibited at "_YSCLST
39 I X="LOCK DOWN OFF" S $P(^YSCL(603.03,1,1),"^",1)=0 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Clozapine dispensing enabled at "_YSCLST
40 G EXIT^YSCLSERV
41 Q
42AUTH ;List authorized Clozapine providers
43 I YSCLSUB["LIST" D G EXIT^YSCLSERV
44 . S ^TMP($J,"YSCLDATA",1)="The following providers are authorized to override Clozapine lockouts"
45 . S YSCLLN=2
46 . S YSCLA="" F S YSCLA=$O(^XUSEC("PSOLOCKCLOZ",YSCLA)) Q:YSCLA="" D
47 . . Q:'$D(^VA(200,YSCLA,0))
48 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$P(^VA(200,YSCLA,0),"^",1)_" "_$S($P(^VA(200,YSCLA,0),"^",7)=1:"Ina",1:"A")_"ctive",YSCLLN=YSCLLN+1
49 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1
50 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1
51 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1
52 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to access the Pharmacy Clozapine Manager Menu",YSCLLN=YSCLLN+1
53 . S YSCLA="" F S YSCLA=$O(^XUSEC("PSZ CLOZAPINE",YSCLA)) Q:YSCLA="" D
54 . . Q:'$D(^VA(200,YSCLA,0))
55 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$P(^VA(200,YSCLA,0),"^",1)_" "_$S($P(^VA(200,YSCLA,0),"^",7)=1:"Ina",1:"A")_"ctive",YSCLLN=YSCLLN+1
56 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1
57 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1
58 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1
59 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to prescribe Clozapine",YSCLLN=YSCLLN+1
60 . S YSCLA=0 F S YSCLA=$O(^XUSEC("YSCL AUTHORIZED",YSCLA)) Q:'YSCLA D ;??? Use FileMan lookup on 200
61 . . S YSCLDEA=$$DEA^XUSER(1,YSCLA),YSCLYN=1,YSCLSSN=$P(^VA(200,YSCLA,1),"^",9)
62 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$P($G(^VA(200,YSCLA,0)),"^",1)_" - "_YSCLSSN_" - "_$S(YSCLDEA="":"*NONE*",1:YSCLDEA)_" - "_$S(YSCLYN=1:"Yes",1:"NO"),YSCLLN=YSCLLN+1
63 ;Holders of YSCL AUTHORIZED key
64 ;=============================================
65 ;
66 S YSCLLN=1,^TMP($J,"YSCLDATA",YSCLLN)="Clinician Authorization Results at "_YSCLST,YSCLLN=YSCLLN+1
67 K ^TMP("DIERR",$J)
68 F X XMREC Q:XMER<0 S X=XMRG X ^%ZOSF("UPPERCASE") S X=Y D
69 . S YSCLSSN=$P(X,"^",1),YSCLDEA=$P(X,"^",2),YSCLYN=$P(X,"^",3),YSCLDUZ="",YSCLDEA1="",YSCLIEN=""
70 . I YSCLLN=""!("YESNO"'[YSCLYN) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician Authorization instructions invalid ("_YSCLYN_") at "_YSCLST,YSCLLN=YSCLLN+1
71 . S YSCLYN=$S(YSCLYN="YES":1,1:0)
72 . I '$D(^VA(200,"BS5",YSCLSSN)) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") does not exist at "_YSCLST,YSCLLN=YSCLLN+1 Q
73 . I $D(^VA(200,"BS5",YSCLSSN)) S YSCLAA="" F S YSCLAA=$O(^VA(200,"BS5",YSCLSSN,YSCLAA)) Q:YSCLAA="" I $$DEA^XUSER(1,YSCLAA)=YSCLDEA S YSCLDUZ=YSCLAA Q
74 . I YSCLDUZ="" S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") with DEA# "_YSCLDEA_" does not exist at "_YSCLST,YSCLLN=YSCLLN+1 Q
75 . S YSCLDEA1=$$DEA^XUSER(1,YSCLDUZ)
76 . I YSCLDEA1="" S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician with DEA# "_YSCLDEA_" does not exist at "_YSCLST,YSCLLN=YSCLLN+1 Q
77 . I YSCLDEA'=YSCLDEA1 W ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN ("_YSCLSSN_") - DEA ("_YSCLDEA_") mismatch at "_YSCLST,YSCLLN=YSCLLN+1 Q
78 . D OWNSKEY^XUSRB(.RET,"YSCL AUTHORIZED",YSCLDUZ)
79 . I RET(0),YSCLYN S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") already authorized at "_YSCLST,YSCLLN=YSCLLN+1 Q
80 . I 'RET(0),'YSCLYN S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") not authorized at "_YSCLST,YSCLLN=YSCLLN+1 Q
81 . I 'RET(0),YSCLYN S YSCLDUZ(0)=DUZ,DUZ(0)="@" D S DUZ(0)=YSCLDUZ(0)
82 . . S YSCLFDA(200,"?1,",.01)="`"_YSCLDUZ
83 . . S YSCLFDA(200.051,"+2,?1,",.01)="YSCL AUTHORIZED" D UPDATE^DIE("E","YSCLFDA",,"YSCLERR")
84 . . I $D(YSCLERR) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization failed at "_YSCLST,YSCLLN=YSCLLN+1 Q
85 . . I '$D(YSCLERR) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization set to "_$S(YSCLYN=1:"Yes",1:"No")_" at "_YSCLST,YSCLLN=YSCLLN+1 Q
86 . I RET(0),'YSCLYN S YSCLDUZ(0)=DUZ,DUZ(0)="@" D S DUZ(0)=YSCLDUZ(0)
87 . . S DA=$$FIND1^DIC(200.051,","_YSCLDUZ_",","A","YSCL AUTHORIZE")
88 . . I DA<1 S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization removal failed at "_YSCLST,YSCLLN=YSCLLN+1 Q
89 . . S DA(1)=YSCLDUZ,DIK="^VA(200,"_DA(1)_",51," D ^DIK
90 . . S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization removed at "_YSCLST,YSCLLN=YSCLLN+1 Q
91 G EXIT^YSCLSERV
92 Q
93ZEOR ;YSCLSRV3
Note: See TracBrowser for help on using the repository browser.