- 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 Mar 13, 2025@20:49:25 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
