source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLSRV2.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1YSCLSRV2 ;DALOI/RLM-Clozapine data server ;APR 24,1990@15:26
2 ;;5.01;MENTAL HEALTH;**69,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 ^DD("DD" supported by IA #10017
6 ; Reference to ^PS(55 supported by IA #787
7 ; Reference to ^PSDRUG supported by IA #25
8 ; Reference to ^PSRX supported by IA #780
9 ; Reference to ^VA(200 supported by IA #10060
10 ; Reference to $$SITE^VASITE supported by IA #10112
11 ; Reference to $$FMTE^XLFDT() supported by IA #10103
12 ; Reference to ^PSDRUG supported by IA #221
13 ; Reference to ^LAB(60 supported by IA #333
14 ;
15REPORT ;send report of current registrations to the Clozapine group on Forum
16 S XMRG="",YSCLA=0 F S YSCLA=$O(^YSCL(603.01,YSCLA)) Q:'YSCLA S YSCLDTA=$G(^YSCL(603.01,YSCLA,0)) D
17 . I YSCLDTA="" S YSCLER="Clozapine Patient List damaged at " D OUT Q
18 . S YSCLWB=$P(YSCLDTA,"^",3),YSCLWB=$S(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown")
19 . S YSCLER=$P(YSCLDTA,"^")_" is assigned to "_$P($G(^DPT($P(YSCLDTA,"^",2),0)),"^")_" ("_$P($G(^DPT($P(YSCLDTA,"^",2),0)),"^",9)_") "_YSCLWB_" at " D OUT
20 I YSCLSUB["+" S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="====" S YSCLA=0 F S YSCLA=$O(^PS(55,"ASAND",YSCLA)) Q:'YSCLA S YSCLER="" D D:YSCLER]"" OUT ;Transmit the most recent for each patient.
21 . S YSCLDFN=$P(^PS(55,YSCLA,0),"^") ;Find out who we're reporting on
22 . S YSCLNM=$P(^DPT(YSCLDFN,0),"^") ;Get the patients name
23 . S YSCLSD1=YSCLNM_"^"_^PS(55,YSCLA,"SAND") ;Add name to data
24 . S YSCLZZ=YSCLA,$P(YSCLSD1,"^",4)=$P($$CL^YSCLTST2(YSCLDFN),"^",2),YSCLA=YSCLZZ
25 . S YSCLDOC=$P(YSCLSD1,"^",6) I YSCLDOC K DIERR,YSCL200 D FIND^DIC(200,,".01","X","`"_YSCLDOC,,,,,"YSCL200","YERROR") S $P(YSCLSD1,"^",6)=$G(YSCL200("DILIST",1,1))
26 . ;S YSCLDOC=$P(YSCLSD1,"^",6) I YSCLDOC S $P(YSCLSD1,"^",6)=$P($G(^VA(200,YSCLDOC,0)),"^") ;OLD CODE
27 . S $P(YSCLSD1,"^",7)=$P(YSCLSD1,"^",7) ;Pad it to 7 ^-pieces
28 . S YSCLB=0 F S YSCLB=$O(^PS(55,YSCLA,"P",YSCLB)) Q:'YSCLB I $D(^PSRX(^PS(55,YSCLA,"P",YSCLB,0),"SAND")) D ;D OUT ;This will transmit them all
29 . . S YSCLER=YSCLSD1_"^"_$G(^PSRX(^PS(55,YSCLA,"P",YSCLB,0),"SAND"))_"^"
30 . . S Y=$P(YSCLER,"^",7) I Y]"" X ^DD("DD") S $P(YSCLER,"^",7)=Y
31 . . S Y=$P(YSCLER,"^",10) I Y]"" X ^DD("DD") S $P(YSCLER,"^",10)=Y
32 . ;D OUT
33 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Linked Tests:"
34 S YSCLA=0 F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA D
35 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=$P(^LAB(60,$P(^YSCL(603.04,1,1,YSCLA,0),"^",1),0),"^")
36 . S YSCLTYPE=$P(^YSCL(603.04,1,1,YSCLA,0),"^",2),YSCLRPT=$P(^YSCL(603.04,1,1,YSCLA,0),"^",3)
37 . S YSCLTA=" reports "_$S(YSCLTYPE="W":"WHITE BLOOD COUNT",YSCLTYPE="A":"ABSOLUTE NEUTROPHIL COUNT",YSCLTYPE="N":"NEUTROPHIL PERCENT",YSCLTYPE="S":"SEGS %",YSCLTYPE="B":"BANDS %",YSCLTYPE="T":"BANDS A",YSCLTYPE="C":"SEGS A")
38 . S ^TMP($J,"YSCLDATA",YSCLLNT)=^TMP($J,"YSCLDATA",YSCLLNT)_YSCLTA_" "_$S(YSCLRPT:"K/units",1:"units")
39 ;Old method
40 ;S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Linked Tests:"
41 ;S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="WBC = "_$$GET1^DIQ(603.02,1,.01)_", Neut% = "_$$GET1^DIQ(603.02,1,1)
42 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Monitored Drug - Monitor Routine - NDC - Lab Test"
43 S YSPR=0 F S YSPR=$O(^PSDRUG(YSPR)) Q:'YSPR I $P($G(^PSDRUG(YSPR,"CLOZ1")),"^")]"" D
44 . S YSCLTC=$P($G(^PSDRUG(YSPR,"CLOZ")),"^") I YSCLTC S YSCLTC=$$GET1^DIQ(60,YSCLTC,.01)
45 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=$P($G(^PSDRUG(YSPR,0)),"^")_" - "_$P(^PSDRUG(YSPR,"CLOZ1"),"^")_" - "_$P($G(^PSDRUG(YSPR,2)),"^",4)_" - "_YSCLTC
46 S YSCLDR=0 F S YSCLDR=$O(^PSDRUG(YSCLDR)) Q:'YSCLDR I $D(^PSDRUG(YSCLDR,"CLOZ2")) D
47 . S YSCLDRA=0 F S YSCLDRA=$O(^PSDRUG(YSCLDR,"CLOZ2",YSCLDRA)) Q:'YSCLDRA D
48 . . S YSCLDRB=^PSDRUG(YSCLDR,"CLOZ2",YSCLDRA,0)
49 . . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=$P(^PSDRUG(YSCLDR,0),"^")_" uses "_$P(^LAB(60,$P(YSCLDRB,"^"),0),"^")_" to indicate "_$S($P(YSCLDRB,"^",4)=1:"White Blood Count",1:"Neutrophil Count")
50 ;D OPTION^%ZTLOAD("YSCL WEEKLY TRANSMISSION","LIST") D
51 ; . S ZTSK="" F S ZTSK=$O(LIST(ZTSK)) Q:ZTSK="" D
52 ; . . D STAT^%ZTLOAD S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Local Task # "_ZTSK_" is "_$S('ZTSK(0):" not ",1:"")_"defined with a status of "_ZTSK(2)
53 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Run day is: "_$P(^YSCL(603.03,1,0),"^",2)
54 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Debug Mode is: "_$S($P(^YSCL(603.03,1,0),"^",3):"On.",1:"Off.")
55 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Last Run Date (start) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",4))
56 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Last Run Date (stop) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",5))
57 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Last Demographic date is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",6))
58 Q
59OUT S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=XMRG_YSCLER_YSCLST Q
60 ;Build the text for the return message here.
61REBUILD ;
62 S XMRG="",(YSCLA,YSCLLNT)=1 F S YSCLA=$O(^PS(55,"ASAND1",YSCLA)) W:'$D(ZTQUEUED) "." Q:YSCLA="" D
63 . S YSCLB=$O(^PS(55,"ASAND1",YSCLA,"")) I YSCLB="" S YSCLER=" record is in error (1) at " D OUT Q
64 . I '$D(^PS(55,YSCLB,0)) S YSCLER=" record is in error (2) at " D OUT Q
65 . S YSCLB=$P(^PS(55,YSCLB,0),"^") I YSCLB="" S YSCLER=" record is in error (3) at " D OUT Q
66 . I '$D(^PS(55,YSCLB,"SAND")) S YSCLER=" record is in error (4) at " D OUT Q
67 . S DIC="^DPT(",DIC(0)="X",D="SSN",(YSCLSSN,X)=$P(^DPT(YSCLB,0),"^",9)
68 . I $D(^YSCL(603.01,"B",YSCLA)) S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=" Clozapine # "_YSCLA_" is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT Q
69 . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q
70 . K DD S DIC="^YSCL(603.01,",X=YSCLA,DIC("DR")="1////"_YSCLPT K DO D FILE^DICN
71 . S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=","_YSCLSSN_" assigned to "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT
72 Q
73OVRRID ;Update record with Monthly, Weekly or Bi-weekly status
74 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
75 . I XMRG'?2U5N1","9N1",".E S YSCLER=" is in error and was not added at " D OUT Q
76 . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number format " D OUT Q
77 . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
78 . K %DT S X=$P(XMRG,",",3),%DT="F" D ^%DT I Y=-1 S YSCLER=" is an invalid date, over-ride authorization not filed at " D OUT Q
79 . S YSCLOVR=Y
80 . S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3)
81 . I '$D(^YSCL(603.01,"B",YSCLNM)) S YSCLER=" does not exist at " D OUT Q
82 . S YSCLDA=$O(^DPT("SSN",YSCLSSN,0))
83 . I YSCLDA="" S YSCLER=" SSN does not exist at " D OUT Q
84 . I $O(^YSCL(603.01,"B",YSCLNM,0))="" S YSCLER=" SSN not in Clozapine file " D OUT Q
85 . I $O(^DPT("SSN",YSCLSSN,YSCLDA)) S YSCLER=" SSN has more than one owner " D OUT Q
86 . I $O(^YSCL(603.01,"B",YSCLNM,0))'=$O(^YSCL(603.01,"C",YSCLDA,0)) S YSCLER=" SSN ("_YSCLSSN_","_$P(^DPT(YSCLDA,0),"^")_") has multiple Clozapine Numbers at " D OUT
87 . I $O(^YSCL(603.01,"B",YSCLNM,0))=$O(^YSCL(603.01,"C",YSCLDA,0)) D
88 . . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0)) S $P(^YSCL(603.01,YSCLDA1,0),"^",4)=YSCLOVR
89 . . S Y=YSCLOVR D DD^%DT S YSCLER=" "_YSCLNM_" ("_$P(^DPT(YSCLDA,0),"^")_") authorized for over-ride on "_Y_" at " D OUT
90 G EXIT^YSCLSERV
91ZEOR ;YSCLSRV2
Note: See TracBrowser for help on using the repository browser.