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 ---[H[J[2J[HPSD84P 1262 printed Nov 22, 2024@16:54:56 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
