- 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 Jan 18, 2025@03:34:21 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