- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLSRV3.m
r613 r623 1 YSCLSRV3 2 ;;5.01;MENTAL HEALTH;**74,90,92**;Dec 30, 1994;Build 7 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ACTIVE 26 27 28 DEMOG 29 30 31 32 33 34 35 36 LOCK 37 38 39 40 41 42 AUTH 43 44 . S ^TMP($J,"YSCLDATA",1)="The following providers are authorized to override Clozapine lockouts (PSOLOCKCLOZ)"45 46 47 48 49 50 51 52 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to access the Pharmacy Clozapine Manager Menu (PSZ CLOZAPINE)",YSCLLN=YSCLLN+153 54 55 56 57 58 59 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to prescribe Clozapine (YSCL AUTHORIZED)",YSCLLN=YSCLLN+160 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 ZEOR 1 YSCLSRV3 ;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 25 ACTIVE ; 26 S YSACT=$$GET1^DIQ(52,YSCL1_",",100,"I","ERR") 27 Q 28 DEMOG ; 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 36 LOCK ;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 42 AUTH ;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 93 ZEOR ;YSCLSRV3
Note:
See TracChangeset
for help on using the changeset viewer.
