Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSA81PI

PSA81PI.m

Go to the documentation of this file. 
  1. PSA81PI ;PER/ME-Post-install routine for Patch PSA*3.0*81 ; 04 Jul 2020  2:00 PM
  1.  ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**81**;Oct 24,1997;Build 10
  1.  Q
  1. POST ; Entry point
  1.  K ^TMP("PSA81PI"),^XTMP("PSA81PI")
  1.  S $P(SETTXT,"=",80)="",$P(SETTXT1,"-",80)=""
  1.  D BMES^XPDUTL("  Starting post-install for PSA*3*81")
  1.  S PSOLINE=0
  1.  D SETTXT(SETTXT)
  1.  D SETTXT("        This report displays drugs with a negative balance in the")
  1.  D SETTXT("                 Controlled Substance master vault(s).")
  1.  D SETTXT(SETTXT1)
  1.  D SETTXT("        If any negative balances are found that require assistance")
  1.  D SETTXT("        to correct, please log a ticket and request it be sent to")
  1.  D SETTXT("        SPM.Health.PCS.Sub_1.")
  1.  D SETTXT(SETTXT)
  1.  ;
  1. REPORT ;
  1.  S VAULT=0
  1.  F  S VAULT=$O(^PSD(58.8,VAULT)) Q:+VAULT=0  D
  1.  .I $P(^PSD(58.8,VAULT,0),U,2)="M" S PSDS=VAULT,PSDSN=$P(^PSD(58.8,VAULT,0),U) D START
  1.  D MAIL
  1.  D BMES^XPDUTL("  Mailman message sent.")
  1.  D BMES^XPDUTL("  Finished post-install for PSA*3*81.")
  1.  D BMES^XPDUTL("")
  1.  Q
  1.  ;
  1. START ;entry for compile report data
  1.  K ^TMP("PSDBALI"),CNT
  1.  F PSD=0:0 S PSD=$O(^PSD(58.8,+PSDS,1,PSD)) Q:'PSD  I $D(^PSD(58.8,+PSDS,1,PSD,0)) D
  1.  .S DEA=+$P($G(^PSDRUG(PSD,0)),"^",3)
  1.  .S PSDR(+PSD)=""
  1.  F PSD=0:0 S PSD=$O(PSDR(PSD)) Q:'PSD  I $D(^PSD(58.8,+PSDS,1,PSD,0)) S NODE=^(0) D
  1.  .S PSDOK="" I +$P(NODE,"^",14),+$P(NODE,"^",14)'>DT Q:'+$P(NODE,"^",4)  S PSDOK="*"
  1.  .S BAL=+$P(NODE,"^",4),DRUGN=$S($P($G(^PSDRUG(+PSD,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSD_" NAME MISSING"),SLVL=+$P(NODE,"^",3),EXP=$S(+$P(NODE,"^",12):+$P(NODE,"^",12),1:"")
  1.  .I EXP S Y=EXP X ^DD("DD") S EXP=Y
  1.  .S ^TMP("PSDBALI",$J,DRUGN,PSD)=BAL_"^"_PSDOK_"^"_SLVL_"^"_EXP_"^"_$P($G(^PSDRUG(+PSD,0)),"^",3)
  1. PRINT ;set each drug line in the report
  1.  S (PSDOUT)=0 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
  1.  D HDR
  1.  I '$D(^TMP("PSDBALI",$J)) W !!,?15,"**** NO STOCK BALANCE DATA AVAILABLE ****",!!
  1.  S PSDR="" F  S PSDR=$O(^TMP("PSDBALI",$J,PSDR)) Q:PSDR=""!(PSDOUT)  F PSD=0:0 S PSD=$O(^TMP("PSDBALI",$J,PSDR,PSD)) Q:'PSD  D  Q:PSDOUT
  1.  .S NODE=^TMP("PSDBALI",$J,PSDR,PSD),BAL=+NODE,PSDOK=$P(NODE,"^",2),SLVL=$P(NODE,"^",3),EXP=$P(NODE,"^",4)
  1.  .S PSD=PSD_$J("",15-$L(PSD))
  1.  .S PSDR=PSDR_$J("",41-$L(PSDR))
  1.  .S BAL=BAL_$J("",10-$L(BAL))
  1.  .I BAL<0 S RPLINE=PSD_PSDR_"         "_BAL D SETTXT(RPLINE) S CNT=1
  1.  I '$D(CNT) D SETTXT("NO NEGATIVE BALANCES FOUND")
  1.  D SETTXT("")
  1.  ;D SETTXT("END OF REPORT FOR THE "_PSDSN_" ("_VAULT_")")
  1.  D SETTXT("End of report for the "_PSDSN_" ("_VAULT_")")
  1.  D SETTXT(""),SETTXT("")
  1.  Q
  1.  ;
  1. END ;
  1.  K %,BAL,DRUGN,EXP,NODE,PSD,PSDOK,PSDOUT,PSDR,PSDRN,PSDS,PSDSN,PSOLINE,SETTXT,SETTXT1,SLVL,RPDT,RPLINE,VAULT,Y
  1.  K ^TMP("PSDBALI",$J),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,DEA,SCH
  1.  K ^TMP("PSA81PI",$J),^XTMP("PSA81PI",$J)
  1.  Q
  1.  ;
  1. HDR ;header
  1.  D SETTXT("")
  1.  D SETTXT($J("",12)_"Negative balance report for the "_PSDSN_" ("_VAULT_")")
  1.  D SETTXT($J("",29)_RPDT)
  1.  D SETTXT("")
  1.  D SETTXT("DRUG IEN"_$J("",14)_"DRUG"_$J("",34)_"CURRENT BALANCE")
  1.  D SETTXT(SETTXT1)
  1.  D SETTXT("")
  1.  Q
  1.  ;
  1. SETTXT(TXT) ; Setting Plain Text
  1.  S PSOLINE=$G(PSOLINE)+1,^XTMP("PSA81PI",$J,PSOLINE)=TXT
  1.  Q
  1.  ;
  1. MAIL ; Sends Mailman message
  1.  N II,XMX,XMSUB,XMDUZ,XMTEXT,XMY
  1.  S II=0 F  S II=$O(^XUSEC("PSNMGR",II)) Q:'II  S XMY(II)=""
  1.  S XMY(DUZ)="",XMSUB="PSA*3*81 - Negative balances in Controlled Substance Vault Report"
  1.  S XMDUZ=.5,XMTEXT="^XTMP(""PSA81PI"",$J," N DIFROM D ^XMD
  1.  Q