PSO574P ; HEC/hrubovcak - NCC Pre-install;1 Oct 2019 12:31:04
;;7.0;OUTPATIENT PHARMACY;**574**;DEC 1997;Build 53
;
Q
;
START ; pre-init for PSO*7*574 - 1 October 2019
D DT^DICRW
N RGZRO,STNUM,Y
D ; lookup PSOCLOZ Mail Group, set TYPE to PUBLIC, ALLOW SELF ENROLLMENT? to NO
. N DA,DIE,DR,PSFMERR
. S DA=$$FIND1^DIC(3.8,"","B","PSOCLOZ","","","PSFMERR") Q:'(DA>0)
. S DIE="^XMB(3.8,",DR="4///PU;7///n" D ^DIE
. D BMES^XPDUTL("PSOCLOZ Mail Group updated.")
;
D XTMPZRO^PSOCLOU
S STNUM=1000+$P($$SITE^VASITE,U,3),RGZRO=$G(^XTMP("PSJ CLOZ",0)),$P(RGZRO,U,4)="Z"_$E(STNUM,2,4)_"999"
S ^XTMP("PSJ CLOZ",0)=RGZRO
D BMES^XPDUTL("CLOZAPINE WEEKEND REGISTRATION list updated in "_$NA(^XTMP("PSJ CLOZ")))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO574P 738 printed Nov 22, 2024@17:33:17 Page 2
PSO574P ; HEC/hrubovcak - NCC Pre-install;1 Oct 2019 12:31:04
+1 ;;7.0;OUTPATIENT PHARMACY;**574**;DEC 1997;Build 53
+2 ;
+3 QUIT
+4 ;
START ; pre-init for PSO*7*574 - 1 October 2019
+1 DO DT^DICRW
+2 NEW RGZRO,STNUM,Y
+3 ; lookup PSOCLOZ Mail Group, set TYPE to PUBLIC, ALLOW SELF ENROLLMENT? to NO
Begin DoDot:1
+4 NEW DA,DIE,DR,PSFMERR
+5 SET DA=$$FIND1^DIC(3.8,"","B","PSOCLOZ","","","PSFMERR")
if '(DA>0)
QUIT
+6 SET DIE="^XMB(3.8,"
SET DR="4///PU;7///n"
DO ^DIE
+7 DO BMES^XPDUTL("PSOCLOZ Mail Group updated.")
End DoDot:1
+8 ;
+9 DO XTMPZRO^PSOCLOU
+10 SET STNUM=1000+$PIECE($$SITE^VASITE,U,3)
SET RGZRO=$GET(^XTMP("PSJ CLOZ",0))
SET $PIECE(RGZRO,U,4)="Z"_$EXTRACT(STNUM,2,4)_"999"
+11 SET ^XTMP("PSJ CLOZ",0)=RGZRO
+12 DO BMES^XPDUTL("CLOZAPINE WEEKEND REGISTRATION list updated in "_$NAME(^XTMP("PSJ CLOZ")))
+13 QUIT
+14 ;
