PSO574P.m

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 ---PSO574P   738     printed  Apr 09, 2024@21:26:04                                                                                                                                                                                                      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      ;