PSSP138 ;BIR/RJS-DOSAGE FORM NOUN & LOCAL POSSIBLE DOSAGE "&" CLEANUP
;;1.0; PHARMACY DATA MANAGEMENT;**138**;9/30/97;Build 5
;;Reference to $$SETSTR^VALM1 is covered by DBIA #10116
;;Reference to $$TRIM^XLFSTR is covered by DBIA #10104
;;Reference to ^XMD is covered by DBIA #10070
;;
NOUN ;CONVERY & TO AND
N X
S PSSIEN=0 F S PSSIEN=$O(^PS(50.606,PSSIEN)) Q:'PSSIEN D
.S PSSNN=0 F S PSSNN=$O(^PS(50.606,PSSIEN,"NOUN",PSSNN)) Q:'PSSNN D
..S PSSNNN=$G(^PS(50.606,PSSIEN,"NOUN",PSSNN,0))
..I PSSNNN["&" S PSLOCV=$P(PSSNNN,"^",1) D
...D AMP^PSSORPH1
...S PSSNNN=$$TRIM^XLFSTR(PSLOCV,"LR"," ") K PSLOCV
...S ^TMP($J,"PSSP138-1",PSSIEN,PSSNN)=PSSNNN
S XMSUB="PSS*1*138 Dosage Form Repair Report",PSSRPT="PSSP138-N"
S ^TMP($J,PSSRPT,1)="PSS*1*138 Dosage Form Repair"
S ^TMP($J,PSSRPT,2)="The following Dosage Form NOUNS have been converted"
S ^TMP($J,PSSRPT,3)=""
I '$D(^TMP($J,"PSSP138-1")) S ^TMP($J,"PSSP138",4)="No NOUNS found containing &.",^TMP($J,PSSRPT,5)="",PSSCNT=5 D MAIL G DOS2
S X="" D TXT("DOSAGE FORM",1),TXT("IEN",40),TXT("NOUN",48)
S ^TMP($J,PSSRPT,4)=X,^TMP($J,PSSRPT,5)="",PSSCNT=5
S PSSIEN=0 F S PSSIEN=$O(^TMP($J,"PSSP138-1",PSSIEN)) Q:'PSSIEN D
.S PSSNN=0 F S PSSNN=$O(^TMP($J,"PSSP138-1",PSSIEN,PSSNN)) Q:'PSSNN D
..N DIE,DA,DR
..S PSSNM=$G(^TMP($J,"PSSP138-1",PSSIEN,PSSNN)),DA(1)=PSSIEN,DA=PSSNN
..S DIE="^PS(50.606,"_DA(1)_","_"""NOUN"""_",",DR=".01////^S X=PSSNM" D ^DIE
..S X="" D TXT($P(^PS(50.606,PSSIEN,0),"^"),1),TXT(PSSIEN,40),TXT(PSSNM,48)
..S PSSCNT=PSSCNT+1,^TMP($J,PSSRPT,PSSCNT)=X
S PSSCNT=PSSCNT+1,^TMP($J,PSSRPT,PSSCNT)=""
D MAIL
;
DOS2 ; Check and replace the "&" with "AND".
N X
S PSSDRG=0 F S PSSDRG=$O(^PSDRUG(PSSDRG)) Q:'PSSDRG!(PSSDRG>999999999) D
.S PSSDOS=0 F S PSSDOS=$O(^PSDRUG(PSSDRG,"DOS2",PSSDOS)) Q:'PSSDOS!(PSSDOS>9999) D
..S PSSDOS2=$G(^PSDRUG(PSSDRG,"DOS2",PSSDOS,0))
..I PSSDOS2["&" S PSLOCV=$P(PSSDOS2,"^",1) D
...D AMP^PSSORPH1
...S PSSDOS2=$$TRIM^XLFSTR(PSLOCV,"LR"," ")
...S ^TMP($J,"PSSP138-2",PSSDRG,PSSDOS)=PSSDOS2
S XMSUB="PSS*1*138 Local Possible Dosage Repair Report",PSSRPT="PSSP138-D"
S ^TMP($J,PSSRPT,1)="PSS*1*138 Local Possible Dosage Repair"
S ^TMP($J,PSSRPT,2)="The following Local Possible Dosages have been fixed"
S ^TMP($J,PSSRPT,3)=""
I '$D(^TMP($J,"PSSP138-2")) S ^TMP($J,PSSRPT,4)="No Local Possible Dosages found containing &.",^TMP($J,PSSRPT,5)="",PSSCNT=5 D MAIL G EXIT
S X="" D TXT("Drug",1),TXT("IEN",40),TXT("Local Possible Dosage",48)
S ^TMP($J,PSSRPT,4)=X,^TMP($J,PSSRPT,5)="",PSSCNT=5
S PSSDRG=0 F S PSSDRG=$O(^TMP($J,"PSSP138-2",PSSDRG)) Q:'PSSDRG D
.S PSSIEN=0 F S PSSIEN=$O(^TMP($J,"PSSP138-2",PSSDRG,PSSIEN)) Q:'PSSIEN D
..N DIE,DA,DR
..S PSSNM=$G(^TMP($J,"PSSP138-2",PSSDRG,PSSIEN)),DA(1)=PSSDRG,DA=PSSIEN
..S DIE="^PSDRUG("_DA(1)_","_"""DOS2"",",DR=".01////^S X=PSSNM" D ^DIE
..S X="" D TXT($P(^PSDRUG(PSSDRG,0),"^"),1),TXT(PSSIEN,40),TXT(PSSNM,48)
..S PSSCNT=PSSCNT+1,^TMP($J,PSSRPT,PSSCNT)=X
S PSSCNT=PSSCNT+1,^TMP($J,PSSRPT,PSSCNT)=""
MAIL N DIFROM
S PSSCNT=PSSCNT+1,^TMP($J,PSSRPT,PSSCNT)="***** End Of Report *****"
S XMTEXT="^TMP($J,PSSRPT,",XMDUZ="PSS*1*138 Post Install"
S XMY(DUZ)=""
D ^XMD
EXIT ; CLEAN UP
K ^TMP($J),PSSCNT,PSSIEN,PSSDRG,PSSDOS,PSSDOS2,XMDUZ,XMSUB,XMTEXT,XMY,PSSNN,PSSNM,PSSNNN,PSSRPT
Q
TXT(VAL,COL) S:'$D(X) X="" S X=$$SETSTR^VALM1(VAL,X,COL,$L(VAL))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP138 3415 printed Sep 23, 2025@20:09:16 Page 2
PSSP138 ;BIR/RJS-DOSAGE FORM NOUN & LOCAL POSSIBLE DOSAGE "&" CLEANUP
+1 ;;1.0; PHARMACY DATA MANAGEMENT;**138**;9/30/97;Build 5
+2 ;;Reference to $$SETSTR^VALM1 is covered by DBIA #10116
+3 ;;Reference to $$TRIM^XLFSTR is covered by DBIA #10104
+4 ;;Reference to ^XMD is covered by DBIA #10070
+5 ;;
NOUN ;CONVERY & TO AND
+1 NEW X
+2 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^PS(50.606,PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+3 SET PSSNN=0
FOR
SET PSSNN=$ORDER(^PS(50.606,PSSIEN,"NOUN",PSSNN))
if 'PSSNN
QUIT
Begin DoDot:2
+4 SET PSSNNN=$GET(^PS(50.606,PSSIEN,"NOUN",PSSNN,0))
+5 IF PSSNNN["&"
SET PSLOCV=$PIECE(PSSNNN,"^",1)
Begin DoDot:3
+6 DO AMP^PSSORPH1
+7 SET PSSNNN=$$TRIM^XLFSTR(PSLOCV,"LR"," ")
KILL PSLOCV
+8 SET ^TMP($JOB,"PSSP138-1",PSSIEN,PSSNN)=PSSNNN
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET XMSUB="PSS*1*138 Dosage Form Repair Report"
SET PSSRPT="PSSP138-N"
+10 SET ^TMP($JOB,PSSRPT,1)="PSS*1*138 Dosage Form Repair"
+11 SET ^TMP($JOB,PSSRPT,2)="The following Dosage Form NOUNS have been converted"
+12 SET ^TMP($JOB,PSSRPT,3)=""
+13 IF '$DATA(^TMP($JOB,"PSSP138-1"))
SET ^TMP($JOB,"PSSP138",4)="No NOUNS found containing &."
SET ^TMP($JOB,PSSRPT,5)=""
SET PSSCNT=5
DO MAIL
GOTO DOS2
+14 SET X=""
DO TXT("DOSAGE FORM",1)
DO TXT("IEN",40)
DO TXT("NOUN",48)
+15 SET ^TMP($JOB,PSSRPT,4)=X
SET ^TMP($JOB,PSSRPT,5)=""
SET PSSCNT=5
+16 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP138-1",PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+17 SET PSSNN=0
FOR
SET PSSNN=$ORDER(^TMP($JOB,"PSSP138-1",PSSIEN,PSSNN))
if 'PSSNN
QUIT
Begin DoDot:2
+18 NEW DIE,DA,DR
+19 SET PSSNM=$GET(^TMP($JOB,"PSSP138-1",PSSIEN,PSSNN))
SET DA(1)=PSSIEN
SET DA=PSSNN
+20 SET DIE="^PS(50.606,"_DA(1)_","_"""NOUN"""_","
SET DR=".01////^S X=PSSNM"
DO ^DIE
+21 SET X=""
DO TXT($PIECE(^PS(50.606,PSSIEN,0),"^"),1)
DO TXT(PSSIEN,40)
DO TXT(PSSNM,48)
+22 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,PSSRPT,PSSCNT)=X
End DoDot:2
End DoDot:1
+23 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,PSSRPT,PSSCNT)=""
+24 DO MAIL
+25 ;
DOS2 ; Check and replace the "&" with "AND".
+1 NEW X
+2 SET PSSDRG=0
FOR
SET PSSDRG=$ORDER(^PSDRUG(PSSDRG))
if 'PSSDRG!(PSSDRG>999999999)
QUIT
Begin DoDot:1
+3 SET PSSDOS=0
FOR
SET PSSDOS=$ORDER(^PSDRUG(PSSDRG,"DOS2",PSSDOS))
if 'PSSDOS!(PSSDOS>9999)
QUIT
Begin DoDot:2
+4 SET PSSDOS2=$GET(^PSDRUG(PSSDRG,"DOS2",PSSDOS,0))
+5 IF PSSDOS2["&"
SET PSLOCV=$PIECE(PSSDOS2,"^",1)
Begin DoDot:3
+6 DO AMP^PSSORPH1
+7 SET PSSDOS2=$$TRIM^XLFSTR(PSLOCV,"LR"," ")
+8 SET ^TMP($JOB,"PSSP138-2",PSSDRG,PSSDOS)=PSSDOS2
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET XMSUB="PSS*1*138 Local Possible Dosage Repair Report"
SET PSSRPT="PSSP138-D"
+10 SET ^TMP($JOB,PSSRPT,1)="PSS*1*138 Local Possible Dosage Repair"
+11 SET ^TMP($JOB,PSSRPT,2)="The following Local Possible Dosages have been fixed"
+12 SET ^TMP($JOB,PSSRPT,3)=""
+13 IF '$DATA(^TMP($JOB,"PSSP138-2"))
SET ^TMP($JOB,PSSRPT,4)="No Local Possible Dosages found containing &."
SET ^TMP($JOB,PSSRPT,5)=""
SET PSSCNT=5
DO MAIL
GOTO EXIT
+14 SET X=""
DO TXT("Drug",1)
DO TXT("IEN",40)
DO TXT("Local Possible Dosage",48)
+15 SET ^TMP($JOB,PSSRPT,4)=X
SET ^TMP($JOB,PSSRPT,5)=""
SET PSSCNT=5
+16 SET PSSDRG=0
FOR
SET PSSDRG=$ORDER(^TMP($JOB,"PSSP138-2",PSSDRG))
if 'PSSDRG
QUIT
Begin DoDot:1
+17 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP138-2",PSSDRG,PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:2
+18 NEW DIE,DA,DR
+19 SET PSSNM=$GET(^TMP($JOB,"PSSP138-2",PSSDRG,PSSIEN))
SET DA(1)=PSSDRG
SET DA=PSSIEN
+20 SET DIE="^PSDRUG("_DA(1)_","_"""DOS2"","
SET DR=".01////^S X=PSSNM"
DO ^DIE
+21 SET X=""
DO TXT($PIECE(^PSDRUG(PSSDRG,0),"^"),1)
DO TXT(PSSIEN,40)
DO TXT(PSSNM,48)
+22 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,PSSRPT,PSSCNT)=X
End DoDot:2
End DoDot:1
+23 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,PSSRPT,PSSCNT)=""
MAIL NEW DIFROM
+1 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,PSSRPT,PSSCNT)="***** End Of Report *****"
+2 SET XMTEXT="^TMP($J,PSSRPT,"
SET XMDUZ="PSS*1*138 Post Install"
+3 SET XMY(DUZ)=""
+4 DO ^XMD
EXIT ; CLEAN UP
+1 KILL ^TMP($JOB),PSSCNT,PSSIEN,PSSDRG,PSSDOS,PSSDOS2,XMDUZ,XMSUB,XMTEXT,XMY,PSSNN,PSSNM,PSSNNN,PSSRPT
+2 QUIT
TXT(VAL,COL) if '$DATA(X)
SET X=""
SET X=$$SETSTR^VALM1(VAL,X,COL,$LENGTH(VAL))
+1 QUIT
