PSD84P.m

PSD84P ;EPIP/RTW - PSD CONTROL SUBSTANCE WARNING POST INSTALL ; 05/074/18 18:46pm

 ;;3.0;CONTROLLED SUBSTANCES ;**84**;13 Feb 97;Build 15

 ; ICR#  Type  Description

 ;-----  ----  -------------------------------------

 ;10111  Sup   FM lookup on file 3.8 using ^DIC API 

 ;

MAILGRP ;Need to check for a pre existing mail group called CS BALANCE DISCREPANCY if it exists do nothing.

 N PSDMG,PSDMSG,PSDNIEN,PSDRX

 S PSDMG=$$FIND1^DIC(3.8,"","X","CS BALANCE DISCREPANCY","","","")

 D:'PSDMG

 . N PSDMGRP,PSDDESCR,PSDTYPE,PSDORG,MSG,FDA2,FDA,PSDIEN

 . S PSDMGRP="CS BALANCE DISCREPANCY",PSDTYPE="PU",PSDORG=".5"

 . S PSDDESCR(1)="Pharmacy Supervisors Group for reporting Narcotic Balance Discrepancies"

 . S FDA(3.8,"+1,",.01)=PSDMGRP

 . S FDA(3.8,"+1,",4)=PSDTYPE

 . S FDA(3.8,"+1,",5)=PSDORG

 . D UPDATE^DIE("","FDA","FDAIEN","MSG")

 . S PSDNIEN=$O(^XMB(3.8,"B","CS BALANCE DISCREPANCY",0))

 . S PSDMSG(1)="Pharmacy Supervisors Group for reporting Narcotic Balance Discrepancies"

 . D WP^DIE(3.8,PSDNIEN_",",3,,"PSDMSG")

 . K FDA,FDAIEN

 I $D(MSG) D  Q

 . S PSDRX="Mail Group Creation Failed.  The following error message was returned:"

 . W !

 . D MES^XPDUTL(PSDRX)

 S PSDRX="Mail Group created successfully."

 D MES^XPDUTL(PSDRX)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSD84P   1262     printed  Apr 09, 2024@20:52:26                                                                                                                                                                                                      Page 2

PSD84P    ;EPIP/RTW - PSD CONTROL SUBSTANCE WARNING POST INSTALL ; 05/074/18 18:46pm

 +1       ;;3.0;CONTROLLED SUBSTANCES ;**84**;13 Feb 97;Build 15

 +2       ; ICR#  Type  Description

 +3       ;-----  ----  -------------------------------------

 +4       ;10111  Sup   FM lookup on file 3.8 using ^DIC API 

 +5       ;

MAILGRP   ;Need to check for a pre existing mail group called CS BALANCE DISCREPANCY if it exists do nothing.

 +1        NEW PSDMG,PSDMSG,PSDNIEN,PSDRX

 +2        SET PSDMG=$$FIND1^DIC(3.8,"","X","CS BALANCE DISCREPANCY","","","")

 +3        if 'PSDMG

               Begin DoDot:1

 +4                NEW PSDMGRP,PSDDESCR,PSDTYPE,PSDORG,MSG,FDA2,FDA,PSDIEN

 +5                SET PSDMGRP="CS BALANCE DISCREPANCY"

                   SET PSDTYPE="PU"

                   SET PSDORG=".5"

 +6                SET PSDDESCR(1)="Pharmacy Supervisors Group for reporting Narcotic Balance Discrepancies"

 +7                SET FDA(3.8,"+1,",.01)=PSDMGRP

 +8                SET FDA(3.8,"+1,",4)=PSDTYPE

 +9                SET FDA(3.8,"+1,",5)=PSDORG

 +10               DO UPDATE^DIE("","FDA","FDAIEN","MSG")

 +11               SET PSDNIEN=$ORDER(^XMB(3.8,"B","CS BALANCE DISCREPANCY",0))

 +12               SET PSDMSG(1)="Pharmacy Supervisors Group for reporting Narcotic Balance Discrepancies"

 +13               DO WP^DIE(3.8,PSDNIEN_",",3,,"PSDMSG")

 +14               KILL FDA,FDAIEN

               End DoDot:1

 +15       IF $DATA(MSG)

               Begin DoDot:1

 +16               SET PSDRX="Mail Group Creation Failed.  The following error message was returned:"

 +17               WRITE !

 +18               DO MES^XPDUTL(PSDRX)

               End DoDot:1

               QUIT 

 +19       SET PSDRX="Mail Group created successfully."

 +20       DO MES^XPDUTL(PSDRX)

 +21       QUIT