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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP170 6081 printed Dec 13, 2024@02:33:40 Page 2
PSSP170 ;DAL/RJS-PSS*1.0*170 POST INSTALL ROUTINE
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**170**;9/30/97;Build 5
+2 ;;Reference to $$UP^XLFST is covered by DBIA #10104
+3 ;;
+4 QUIT
POSTINT ; POST INSTALL ENTRY POINT.
+1 SET ZTDESC="PSS*1*170 Post Install"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTRTN="POST^PSSP170"
SET ZTSAVE=""
DO ^%ZTLOAD
+2 DO BMES^XPDUTL("PSS*1*170 Post Install Task Queued!")
+3 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+4 QUIT
POST ;LOOP THROUGH ^PS(51 AND FIND DUPLICATE MEDICATION INSTRUCTIONS AS WELL AS MIXED CASE SYNONYMS
+1 SET PSSNAM=""
FOR
SET PSSNAM=$ORDER(^PS(51,"B",PSSNAM))
if PSSNAM=""
QUIT
Begin DoDot:1
+2 SET PSSINDX=$$UP^XLFSTR(PSSNAM)
SET PSSFLG=0
+3 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^PS(51,"B",PSSNAM,PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:2
+4 SET PSSSYN=""
SET PSSSYN=$PIECE(^PS(51,PSSIEN,0),"^",3)
SET PSSNAME=""
SET PSSNAME=$PIECE(^PS(51,PSSIEN,0),"^",1)
+5 IF PSSNAME=PSSSYN
SET ^TMP($JOB,"PSSP170-1","S",PSSNAM,PSSIEN)=^PS(51,PSSIEN,0)
+6 IF $ORDER(^PS(51,"B",PSSNAM,PSSIEN))
SET PSSFLG=1
+7 IF PSSFLG
SET ^TMP($JOB,"PSSP170-1","D",PSSNAM,PSSIEN)=^PS(51,PSSIEN,0)
+8 IF PSSINDX'=PSSNAM
SET ^TMP($JOB,"PSSP170-1","M",PSSNAM,PSSIEN)=^PS(51,PSSIEN,0)
End DoDot:2
End DoDot:1
+9 SET PSSIEN=0
SET PSSCNT=1
+10 SET ^TMP($JOB,"PSSP170",PSSCNT)="PSS*1*170 Duplicate/Mixedcase Medication Instructions Report"
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
+11 FOR PSSCTR=1:1:79
SET PSSTXT=PSSTXT_"-"
+12 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP170",PSSCNT)=""
SET PSSCNT=PSSCNT+1
+13 SET ^TMP($JOB,"PSSP170",PSSCNT)="The following Medication Instructions have been identified as having a name"
SET PSSCNT=PSSCNT+1
+14 SET ^TMP($JOB,"PSSP170",PSSCNT)="or a synonym that are the same."
SET PSSCNT=PSSCNT+1
+15 SET ^TMP($JOB,"PSSP170",PSSCNT)=""
SET PSSCNT=PSSCNT+1
+16 IF '$DATA(^TMP($JOB,"PSSP170-1"))
GOTO EXIT
+17 DO HDR
TMP SET PSSNAM=""
FOR
SET PSSNAM=$ORDER(^TMP($JOB,"PSSP170-1","D",PSSNAM))
if PSSNAM=""
QUIT
Begin DoDot:1
+1 SET PSSTXT=""
DO TXT(PSSNAM_" **",1)
+2 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP170-1","D",PSSNAM,PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:2
+3 KILL PSSNM,PSSSYN
+4 SET PSSNM=$PIECE(^TMP($JOB,"PSSP170-1","D",PSSNAM,PSSIEN),"^",1)
IF PSSNM=PSSNAM
SET PSSNM=PSSNM_"**"
+5 DO TXT(PSSNM,20)
DO TXT($PIECE(^TMP($JOB,"PSSP170-1","D",PSSNAM,PSSIEN),"^",2),40)
+6 SET PSSSYN=$PIECE(^TMP($JOB,"PSSP170-1","D",PSSNAM,PSSIEN),"^",3)
IF PSSSYN=PSSNAM
SET PSSSYN=PSSSYN_"**"
+7 DO TXT(PSSSYN,60)
+8 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
End DoDot:2
End DoDot:1
+9 SET ^TMP($JOB,"PSSP170",PSSCNT)=""
SET PSSCNT=PSSCNT+1
+10 SET ^TMP($JOB,"PSSP170",PSSCNT)="The duplicate** items will need to be changed to a unique name or synonym"
SET PSSCNT=PSSCNT+1
+11 SET ^TMP($JOB,"PSSP170",PSSCNT)=""
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
+12 FOR PSSCTR=1:1:79
SET PSSTXT=PSSTXT_"="
+13 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
+14 SET ^TMP($JOB,"PSSP170",PSSCNT)=""
SET PSSCNT=PSSCNT+1
+15 SET ^TMP($JOB,"PSSP170",PSSCNT)="The following Medication Instructions have been identified as having a Synonym"
SET PSSCNT=PSSCNT+1
+16 SET ^TMP($JOB,"PSSP170",PSSCNT)="containing lowercase letters."
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
+17 FOR PSSCTR=1:1:79
SET PSSTXT=PSSTXT_"-"
+18 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
+19 SET ^TMP($JOB,"PSSP170",PSSCNT)=""
SET PSSCNT=PSSCNT+1
+20 SET PSSTXT=""
DO TXT("Lowercase **",1)
DO TXT("Name",20)
DO TXT("Expansion",40)
DO TXT("Synonym",60)
+21 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
+22 SET PSSNAM=""
FOR
SET PSSNAM=$ORDER(^TMP($JOB,"PSSP170-1","M",PSSNAM))
if PSSNAM=""
QUIT
Begin DoDot:1
+23 SET PSSTXT=""
DO TXT(PSSNAM_" **",1)
+24 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP170-1","M",PSSNAM,PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:2
+25 KILL PSSNM,PSSSYN
+26 SET PSSNM=$PIECE(^TMP($JOB,"PSSP170-1","M",PSSNAM,PSSIEN),"^",1)
IF PSSNM=PSSNAM
SET PSSNM=PSSNM_"**"
+27 DO TXT(PSSNM,20)
DO TXT($PIECE(^TMP($JOB,"PSSP170-1","M",PSSNAM,PSSIEN),"^",2),40)
+28 SET PSSSYN=$PIECE(^TMP($JOB,"PSSP170-1","M",PSSNAM,PSSIEN),"^",3)
IF PSSSYN=PSSNAM
SET PSSSYN=PSSSYN_"**"
+29 DO TXT(PSSSYN,60)
+30 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
End DoDot:2
End DoDot:1
+31 DO PXRMINDX
+32 DO MAIL
+33 ;
EXIT ; CLEAN UP
+1 KILL ^TMP($JOB),PSSCNT,PSSCTR,PSSIEN,PSSDAS,PSSDFN,PSSINS,PSSNAM,PSSPOI,PSSSDT,PSSSTOP,PSSSTRT,PSSTXT,PSSFLG,PSSINDX,PSSNAME,PSSUSER,XMDUZ,XMSUB,XMTEXT,XMY
+2 QUIT
TXT(PSSVAL,PSSCAL) if '$DATA(PSSTXT)
SET PSSTXT=""
SET PSSTXT=$$SETSTR^VALM1(PSSVAL,PSSTXT,PSSCAL,$LENGTH(PSSVAL))
+1 QUIT
MAIL NEW DIFROM
+1 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP170",PSSCNT)="***** End Of Report *****"
+2 SET XMSUB="PSS*1*170 Duplicate/Mixedcase Medication Instructions Report"
+3 SET XMTEXT="^TMP($J,""PSSP170"","
SET XMDUZ="PSS*1*170 Post Install"
+4 FOR PSSUSER=0:0
SET PSSUSER=$ORDER(^XUSEC("PSNMGR",PSSUSER))
if 'PSSUSER
QUIT
if PSSUSER'=.5
SET XMY(PSSUSER)=""
+5 SET XMY(DUZ)=""
+6 DO ^XMD
+7 QUIT
HDR ;SET REPORT HEADER
+1 SET PSSTXT=""
DO TXT("Duplicate **",1)
DO TXT("Name",20)
DO TXT("Expansion",40)
DO TXT("Synonym",60)
+2 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
SET PSSTXT=""
+3 FOR PSSCTR=1:1:79
SET PSSTXT=PSSTXT_"-"
+4 SET ^TMP($JOB,"PSSP170",PSSCNT)=PSSTXT
SET PSSCNT=PSSCNT+1
+5 QUIT
PXRMINDX ; Clean up the ^PXRMINDX("55NVA" index
+1 SET PSSPOI=0
FOR
SET PSSPOI=$ORDER(^PXRMINDX("55NVA","IP",PSSPOI))
if 'PSSPOI
QUIT
Begin DoDot:1
+2 SET PSSDFN=0
FOR
SET PSSDFN=$ORDER(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN))
if 'PSSDFN
QUIT
Begin DoDot:2
+3 SET PSSSTRT=0
FOR
SET PSSSTRT=$ORDER(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT))
if 'PSSSTRT
QUIT
Begin DoDot:3
+4 SET PSSSTOP=""
FOR
SET PSSSTOP=$ORDER(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSTOP))
if PSSSTOP=""
QUIT
Begin DoDot:4
+5 if PSSSTOP'["U"
QUIT
+6 SET PSSSDT=$PIECE(PSSSTOP,"U",2)
+7 if $LENGTH(PSSDFN)=$LENGTH(PSSSDT)
QUIT
+8 SET PSSSDT="U"_PSSDFN
+9 SET PSSDAS=""
FOR
SET PSSDAS=$ORDER(^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSTOP,PSSDAS))
if PSSDAS=""
QUIT
Begin DoDot:5
+10 KILL ^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSTOP,PSSDAS)
+11 SET ^PXRMINDX("55NVA","IP",PSSPOI,PSSDFN,PSSSTRT,PSSSDT,PSSDAS)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET PSSDFN=0
FOR
SET PSSDFN=$ORDER(^PXRMINDX("55NVA","PI",PSSDFN))
if 'PSSDFN
QUIT
Begin DoDot:1
+13 SET PSSPOI=0
FOR
SET PSSPOI=$ORDER(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI))
if 'PSSPOI
QUIT
Begin DoDot:2
+14 SET PSSSTRT=0
FOR
SET PSSSTRT=$ORDER(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT))
if 'PSSSTRT
QUIT
Begin DoDot:3
+15 SET PSSSTOP=""
FOR
SET PSSSTOP=$ORDER(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSTOP))
if PSSSTOP=""
QUIT
Begin DoDot:4
+16 if PSSSTOP'["U"
QUIT
+17 SET PSSSDT=$PIECE(PSSSTOP,"U",2)
+18 if $LENGTH(PSSDFN)=$LENGTH(PSSSDT)
QUIT
+19 SET PSSSDT="U"_PSSDFN
+20 SET PSSDAS=""
FOR
SET PSSDAS=$ORDER(^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSTOP,PSSDAS))
if PSSDAS=""
QUIT
Begin DoDot:5
+21 KILL ^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSTOP,PSSDAS)
+22 SET ^PXRMINDX("55NVA","PI",PSSDFN,PSSPOI,PSSSTRT,PSSSDT,PSSDAS)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
