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