YSCLPOST ;DVAMC/RLM-Clozapine Post Init ;APR 24,1990@15:26
;;5.01;MENTAL HEALTH;**18,22**;DEC 30, 1994
START ;
S YSCLDOM=$G(^XMB("NETNAME")),YSCLDM=0 S:YSCLDOM="" YSCLDOM="^"
F S YSCLDM=$O(^DIC(4.2,"B",YSCLDOM,YSCLDM)) Q:'YSCLDM Q:$P($G(^DIC(4.2,+YSCLDM,0)),"^")=YSCLDOM
S YSCLST=$P($G(^DIC(4.2,+YSCLDM,0)),"^",13) I YSCLST="" S YSCLST=^DD("SITE")_" ERROR IN FILE 4.2"
S YSCLDATA(1)="No Clozapine patients found at "_YSCLST
S (YSCLA,YSCLLN)=0 F S YSCLA=$O(^PS(55,"ASAND1",YSCLA)) W "." Q:YSCLA="" D
. S YSCLB=$O(^PS(55,"ASAND1",YSCLA,"")) I YSCLB="" S YSCLER=" record is in error (1) at " D ERR Q
. I '$D(^PS(55,YSCLB,0)) S YSCLER=" record is in error (2) at " D ERR Q
. S YSCLB=$P(^PS(55,YSCLB,0),"^") I YSCLB="" S YSCLER=" record is in error (3) at " D ERR Q
. I '$D(^PS(55,YSCLB,"SAND")) S YSCLER=" record is in error (4) at " D ERR Q
. S DIC="^DPT(",DIC(0)="X",D="SSN",(YSCLSSN,X)=$P(^DPT(YSCLB,0),"^",9)
. 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
. D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D ERR Q
. K DD S DIC="^YSCL(603.01,",X=YSCLA,DIC("DR")="1////"_YSCLPT D FILE^DICN
. 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
S %H=$H D YMD^%DTC S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=YSCLST_" NCCC ENROLLER ("_X_%_")",XMTEXT="YSCLDATA(",XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")="" D ^XMD
K %,%H,D,DIC,X,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,YSCLA,YSCLB,YSCLDATA,YSCLDM,YSCLDOM,YSCLER,YSCLLN,YSCLPT,YSCLSSN,YSCLST,YSCLX Q
ERR S YSCLLN=YSCLLN+1,YSCLDATA(YSCLLN)=YSCLA_YSCLER_YSCLST Q
ZEOR ;YSCLPOST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLPOST 1826 printed Dec 13, 2024@02:13:48 Page 2
YSCLPOST ;DVAMC/RLM-Clozapine Post Init ;APR 24,1990@15:26
+1 ;;5.01;MENTAL HEALTH;**18,22**;DEC 30, 1994
START ;
+1 SET YSCLDOM=$GET(^XMB("NETNAME"))
SET YSCLDM=0
if YSCLDOM=""
SET YSCLDOM="^"
+2 FOR
SET YSCLDM=$ORDER(^DIC(4.2,"B",YSCLDOM,YSCLDM))
if 'YSCLDM
QUIT
if $PIECE($GET(^DIC(4.2,+YSCLDM,0)),"^")=YSCLDOM
QUIT
+3 SET YSCLST=$PIECE($GET(^DIC(4.2,+YSCLDM,0)),"^",13)
IF YSCLST=""
SET YSCLST=^DD("SITE")_" ERROR IN FILE 4.2"
+4 SET YSCLDATA(1)="No Clozapine patients found at "_YSCLST
+5 SET (YSCLA,YSCLLN)=0
FOR
SET YSCLA=$ORDER(^PS(55,"ASAND1",YSCLA))
WRITE "."
if YSCLA=""
QUIT
Begin DoDot:1
+6 SET YSCLB=$ORDER(^PS(55,"ASAND1",YSCLA,""))
IF YSCLB=""
SET YSCLER=" record is in error (1) at "
DO ERR
QUIT
+7 IF '$DATA(^PS(55,YSCLB,0))
SET YSCLER=" record is in error (2) at "
DO ERR
QUIT
+8 SET YSCLB=$PIECE(^PS(55,YSCLB,0),"^")
IF YSCLB=""
SET YSCLER=" record is in error (3) at "
DO ERR
QUIT
+9 IF '$DATA(^PS(55,YSCLB,"SAND"))
SET YSCLER=" record is in error (4) at "
DO ERR
QUIT
+10 SET DIC="^DPT("
SET DIC(0)="X"
SET D="SSN"
SET (YSCLSSN,X)=$PIECE(^DPT(YSCLB,0),"^",9)
+11 IF $DATA(^YSCL(603.01,"B",YSCLA))
SET YSCLX=$ORDER(^YSCL(603.01,"B",YSCLA,""))
if YSCLX]""
SET YSCLX=$PIECE(^YSCL(603.01,YSCLX,0),"^",2)
SET YSCLER=" Clozapine # is in use by "_$PIECE($GET(^DPT(YSCLX,0)),"^")_" at "
DO ERR
QUIT
+12 DO MIX^DIC1
SET YSCLPT=+Y
IF Y=-1
SET YSCLER=" could not be added at "
DO ERR
QUIT
+13 KILL DD
SET DIC="^YSCL(603.01,"
SET X=YSCLA
SET DIC("DR")="1////"_YSCLPT
DO FILE^DICN
+14 SET YSCLX=$ORDER(^YSCL(603.01,"B",YSCLA,""))
if YSCLX]""
SET YSCLX=$PIECE(^YSCL(603.01,YSCLX,0),"^",2)
SET YSCLER=","_YSCLSSN_" assigned to "_$PIECE($GET(^DPT(YSCLX,0)),"^")_" at "
DO ERR
End DoDot:1
+15 SET %H=$HOROLOG
DO YMD^%DTC
SET XMDUN="NCCC LOGGER"
SET XMDUZ=".5"
SET XMSUB=YSCLST_" NCCC ENROLLER ("_X_%_")"
SET XMTEXT="YSCLDATA("
SET XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
DO ^XMD
+16 KILL %,%H,D,DIC,X,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,YSCLA,YSCLB,YSCLDATA,YSCLDM,YSCLDOM,YSCLER,YSCLLN,YSCLPT,YSCLSSN,YSCLST,YSCLX
QUIT
ERR SET YSCLLN=YSCLLN+1
SET YSCLDATA(YSCLLN)=YSCLA_YSCLER_YSCLST
QUIT
ZEOR ;YSCLPOST
