- 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 Apr 23, 2025@18:28:12 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
