source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLPOST.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: 1.8 KB
Line 
1YSCLPOST ;DVAMC/RLM-Clozapine Post Init ;APR 24,1990@15:26
2 ;;5.01;MENTAL HEALTH;**18,22**;DEC 30, 1994
3START ;
4 S YSCLDOM=$G(^XMB("NETNAME")),YSCLDM=0 S:YSCLDOM="" YSCLDOM="^"
5 F S YSCLDM=$O(^DIC(4.2,"B",YSCLDOM,YSCLDM)) Q:'YSCLDM Q:$P($G(^DIC(4.2,+YSCLDM,0)),"^")=YSCLDOM
6 S YSCLST=$P($G(^DIC(4.2,+YSCLDM,0)),"^",13) I YSCLST="" S YSCLST=^DD("SITE")_" ERROR IN FILE 4.2"
7 S YSCLDATA(1)="No Clozapine patients found at "_YSCLST
8 S (YSCLA,YSCLLN)=0 F S YSCLA=$O(^PS(55,"ASAND1",YSCLA)) W "." Q:YSCLA="" D
9 . S YSCLB=$O(^PS(55,"ASAND1",YSCLA,"")) I YSCLB="" S YSCLER=" record is in error (1) at " D ERR Q
10 . I '$D(^PS(55,YSCLB,0)) S YSCLER=" record is in error (2) at " D ERR Q
11 . S YSCLB=$P(^PS(55,YSCLB,0),"^") I YSCLB="" S YSCLER=" record is in error (3) at " D ERR Q
12 . I '$D(^PS(55,YSCLB,"SAND")) S YSCLER=" record is in error (4) at " D ERR Q
13 . S DIC="^DPT(",DIC(0)="X",D="SSN",(YSCLSSN,X)=$P(^DPT(YSCLB,0),"^",9)
14 . 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 # is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D ERR Q
15 . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D ERR Q
16 . K DD S DIC="^YSCL(603.01,",X=YSCLA,DIC("DR")="1////"_YSCLPT D FILE^DICN
17 . 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 ERR
18 S %H=$H D YMD^%DTC S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=YSCLST_" NCCC ENROLLER ("_X_%_")",XMTEXT="YSCLDATA(",XMY("G.CLOZAPINE ROLL-UP@FORUM.VA.GOV")="" D ^XMD
19 K %,%H,D,DIC,X,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,YSCLA,YSCLB,YSCLDATA,YSCLDM,YSCLDOM,YSCLER,YSCLLN,YSCLPT,YSCLSSN,YSCLST,YSCLX Q
20ERR S YSCLLN=YSCLLN+1,YSCLDATA(YSCLLN)=YSCLA_YSCLER_YSCLST Q
21ZEOR ;YSCLPOST
Note: See TracBrowser for help on using the repository browser.