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

PSSP170.m

Go to the documentation of this file.
  1. PSSP170 ;DAL/RJS-PSS*1.0*170 POST INSTALL ROUTINE
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**170**;9/30/97;Build 5
  1. ;;Reference to $$UP^XLFST is covered by DBIA #10104
  1. ;;
  1. Q
  1. POSTINT ; POST INSTALL ENTRY POINT.
  1. S ZTDESC="PSS*1*170 Post Install",ZTIO="",ZTDTH=$H,ZTRTN="POST^PSSP170",ZTSAVE="" D ^%ZTLOAD
  1. D BMES^XPDUTL("PSS*1*170 Post Install Task Queued!")
  1. K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1. Q
  1. POST ;LOOP THROUGH ^PS(51 AND FIND DUPLICATE MEDICATION INSTRUCTIONS AS WELL AS MIXED CASE SYNONYMS
  1. S PSSNAM="" F S PSSNAM=$O(^PS(51,"B",PSSNAM)) Q:PSSNAM="" D
  1. .S PSSINDX=$$UP^XLFSTR(PSSNAM),PSSFLG=0
  1. .S PSSIEN=0 F S PSSIEN=$O(^PS(51,"B",PSSNAM,PSSIEN)) Q:'PSSIEN D
  1. ..S PSSSYN="",PSSSYN=$P(^PS(51,PSSIEN,0),"^",3),PSSNAME="",PSSNAME=$P(^PS(51,PSSIEN,0),"^",1)
  1. ..I PSSNAME=PSSSYN S ^TMP($J,"PSSP170-1","S",PSSNAM,PSSIEN)=^PS(51,PSSIEN,0)
  1. ..I $O(^PS(51,"B",PSSNAM,PSSIEN)) S PSSFLG=1
  1. ..I PSSFLG S ^TMP($J,"PSSP170-1","D",PSSNAM,PSSIEN)=^PS(51,PSSIEN,0)
  1. ..I PSSINDX'=PSSNAM S ^TMP($J,"PSSP170-1","M",PSSNAM,PSSIEN)=^PS(51,PSSIEN,0)
  1. S PSSIEN=0,PSSCNT=1
  1. S ^TMP($J,"PSSP170",PSSCNT)="PSS*1*170 Duplicate/Mixedcase Medication Instructions Report",PSSCNT=PSSCNT+1,PSSTXT=""
  1. F PSSCTR=1:1:79 S PSSTXT=PSSTXT_"-"
  1. S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1,^TMP($J,"PSSP170",PSSCNT)="",PSSCNT=PSSCNT+1
  1. S ^TMP($J,"PSSP170",PSSCNT)="The following Medication Instructions have been identified as having a name",PSSCNT=PSSCNT+1
  1. S ^TMP($J,"PSSP170",PSSCNT)="or a synonym that are the same.",PSSCNT=PSSCNT+1
  1. S ^TMP($J,"PSSP170",PSSCNT)="",PSSCNT=PSSCNT+1
  1. I '$D(^TMP($J,"PSSP170-1")) G EXIT
  1. D HDR
  1. TMP S PSSNAM="" F S PSSNAM=$O(^TMP($J,"PSSP170-1","D",PSSNAM)) Q:PSSNAM="" D
  1. .S PSSTXT="" D TXT(PSSNAM_" **",1)
  1. .S PSSIEN=0 F S PSSIEN=$O(^TMP($J,"PSSP170-1","D",PSSNAM,PSSIEN)) Q:'PSSIEN D
  1. ..K PSSNM,PSSSYN
  1. ..S PSSNM=$P(^TMP($J,"PSSP170-1","D",PSSNAM,PSSIEN),"^",1) I PSSNM=PSSNAM S PSSNM=PSSNM_"**"
  1. ..D TXT(PSSNM,20),TXT($P(^TMP($J,"PSSP170-1","D",PSSNAM,PSSIEN),"^",2),40)
  1. ..S PSSSYN=$P(^TMP($J,"PSSP170-1","D",PSSNAM,PSSIEN),"^",3) I PSSSYN=PSSNAM S PSSSYN=PSSSYN_"**"
  1. ..D TXT(PSSSYN,60)
  1. ..S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1,PSSTXT=""
  1. S ^TMP($J,"PSSP170",PSSCNT)="",PSSCNT=PSSCNT+1
  1. S ^TMP($J,"PSSP170",PSSCNT)="The duplicate** items will need to be changed to a unique name or synonym",PSSCNT=PSSCNT+1
  1. S ^TMP($J,"PSSP170",PSSCNT)="",PSSCNT=PSSCNT+1,PSSTXT=""
  1. F PSSCTR=1:1:79 S PSSTXT=PSSTXT_"="
  1. S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1,PSSTXT=""
  1. S ^TMP($J,"PSSP170",PSSCNT)="",PSSCNT=PSSCNT+1
  1. S ^TMP($J,"PSSP170",PSSCNT)="The following Medication Instructions have been identified as having a Synonym",PSSCNT=PSSCNT+1
  1. S ^TMP($J,"PSSP170",PSSCNT)="containing lowercase letters.",PSSCNT=PSSCNT+1,PSSTXT=""
  1. F PSSCTR=1:1:79 S PSSTXT=PSSTXT_"-"
  1. S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1,PSSTXT=""
  1. S ^TMP($J,"PSSP170",PSSCNT)="",PSSCNT=PSSCNT+1
  1. S PSSTXT="" D TXT("Lowercase **",1),TXT("Name",20),TXT("Expansion",40),TXT("Synonym",60)
  1. S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1,PSSTXT=""
  1. S PSSNAM="" F S PSSNAM=$O(^TMP($J,"PSSP170-1","M",PSSNAM)) Q:PSSNAM="" D
  1. .S PSSTXT="" D TXT(PSSNAM_" **",1)
  1. .S PSSIEN=0 F S PSSIEN=$O(^TMP($J,"PSSP170-1","M",PSSNAM,PSSIEN)) Q:'PSSIEN D
  1. ..K PSSNM,PSSSYN
  1. ..S PSSNM=$P(^TMP($J,"PSSP170-1","M",PSSNAM,PSSIEN),"^",1) I PSSNM=PSSNAM S PSSNM=PSSNM_"**"
  1. ..D TXT(PSSNM,20),TXT($P(^TMP($J,"PSSP170-1","M",PSSNAM,PSSIEN),"^",2),40)
  1. ..S PSSSYN=$P(^TMP($J,"PSSP170-1","M",PSSNAM,PSSIEN),"^",3) I PSSSYN=PSSNAM S PSSSYN=PSSSYN_"**"
  1. ..D TXT(PSSSYN,60)
  1. ..S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1,PSSTXT=""
  1. D PXRMINDX
  1. D MAIL
  1. ;
  1. EXIT ; CLEAN UP
  1. K ^TMP($J),PSSCNT,PSSCTR,PSSIEN,PSSDAS,PSSDFN,PSSINS,PSSNAM,PSSPOI,PSSSDT,PSSSTOP,PSSSTRT,PSSTXT,PSSFLG,PSSINDX,PSSNAME,PSSUSER,XMDUZ,XMSUB,XMTEXT,XMY
  1. Q
  1. TXT(PSSVAL,PSSCAL) S:'$D(PSSTXT) PSSTXT="" S PSSTXT=$$SETSTR^VALM1(PSSVAL,PSSTXT,PSSCAL,$L(PSSVAL))
  1. Q
  1. MAIL N DIFROM
  1. S PSSCNT=PSSCNT+1,^TMP($J,"PSSP170",PSSCNT)="***** End Of Report *****"
  1. S XMSUB="PSS*1*170 Duplicate/Mixedcase Medication Instructions Report"
  1. S XMTEXT="^TMP($J,""PSSP170"",",XMDUZ="PSS*1*170 Post Install"
  1. F PSSUSER=0:0 S PSSUSER=$O(^XUSEC("PSNMGR",PSSUSER)) Q:'PSSUSER S:PSSUSER'=.5 XMY(PSSUSER)=""
  1. S XMY(DUZ)=""
  1. D ^XMD
  1. Q
  1. HDR ;SET REPORT HEADER
  1. S PSSTXT="" D TXT("Duplicate **",1),TXT("Name",20),TXT("Expansion",40),TXT("Synonym",60)
  1. S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1,PSSTXT=""
  1. F PSSCTR=1:1:79 S PSSTXT=PSSTXT_"-"
  1. S ^TMP($J,"PSSP170",PSSCNT)=PSSTXT,PSSCNT=PSSCNT+1
  1. Q
  1. PXRMINDX ; Clean up the ^PXRMINDX("55NVA" index
  1. S PSSPOI=0 F S PSSPOI=$O(^PXRMINDX("55NVA","IP",PSSPOI)) Q:'PSSPOI D
  1. .S PSSDFN=0 F S PSSDFN=$O(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN)) Q:'PSSDFN D
  1. ..S PSSSTRT=0 F S PSSSTRT=$O(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT)) Q:'PSSSTRT D
  1. ...S PSSSTOP="" F S PSSSTOP=$O(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSTOP)) Q:PSSSTOP="" D
  1. ....Q:PSSSTOP'["U"
  1. ....S PSSSDT=$P(PSSSTOP,"U",2)
  1. ....Q:$L(PSSDFN)=$L(PSSSDT)
  1. ....S PSSSDT="U"_PSSDFN
  1. ....S PSSDAS="" F S PSSDAS=$O(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSTOP,PSSDAS)) Q:PSSDAS="" D
  1. .....K ^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSTOP,PSSDAS)
  1. .....S ^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSDT,PSSDAS)=""
  1. S PSSDFN=0 F S PSSDFN=$O(^PXRMINDX("55NVA","PI",PSSDFN)) Q:'PSSDFN D
  1. .S PSSPOI=0 F S PSSPOI=$O(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI)) Q:'PSSPOI D
  1. ..S PSSSTRT=0 F S PSSSTRT=$O(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT)) Q:'PSSSTRT D
  1. ...S PSSSTOP="" F S PSSSTOP=$O(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSTOP)) Q:PSSSTOP="" D
  1. ....Q:PSSSTOP'["U"
  1. ....S PSSSDT=$P(PSSSTOP,"U",2)
  1. ....Q:$L(PSSDFN)=$L(PSSSDT)
  1. ....S PSSSDT="U"_PSSDFN
  1. ....S PSSDAS="" F S PSSDAS=$O(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSTOP,PSSDAS)) Q:PSSDAS="" D
  1. .....K ^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSTOP,PSSDAS)
  1. .....S ^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSDT,PSSDAS)=""
  1. Q