PSSP130 ;BIR/RJS-REINDEX "VAC" X-REFERENCE ON DRUG FILE (#50)
;;1.0; PHARMACY DATA MANAGEMENT;**130**;9/30/97;Build 6
;;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
;;
SYN ;Remove the un wanted spaces from the Pharmacy Orderable Items synonym
N X
S PSSIEN=0 F S PSSIEN=$O(^PS(50.7,PSSIEN)) Q:'PSSIEN D
.S PSSSYN=0 F S PSSSYN=$O(^PS(50.7,PSSIEN,2,PSSSYN)) Q:'PSSSYN D
..S PSSNM=$G(^PS(50.7,PSSIEN,2,PSSSYN,0))
..S PSSLEN=$L(PSSNM) S PSSNAM=$$TRIM^XLFSTR(PSSNM,," ")
..I $L(PSSNAM)<$L(PSSNM) S ^TMP($J,"PSSP130-1",PSSIEN,PSSSYN)=PSSNAM
S PSSIEN=0
S XMSUB="PSS*1*130 Pharmacy Orderable Item Synonym Repair Report"
S ^TMP($J,"PSSP130",1)="PSS*1*130 Pharmacy Orderable Item Synonym Repair"
S ^TMP($J,"PSSP130",2)="The following Orderable Items contained leading/trailing spaces"
S ^TMP($J,"PSSP130",3)=""
I '$D(^TMP($J,"PSSP130-1")) S ^TMP($J,"PSSP130",4)="No multiple indexs found.",^TMP($J,"PSSP130",5)="",PSSCNT=5 D MAIL G VAC
S X="" D TXT("ORDERABLE ITEM",1),TXT("IEN",40),TXT("SYNONYM",48)
S ^TMP($J,"PSSP130",4)=X,^TMP($J,"PSSP130",5)="",PSSCNT=5
S PSSIEN=0 F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
.S PSSSYN=0 F S PSSSYN=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSSYN)) Q:'PSSSYN D
..N DIE,DA,DR
..S PSSNM=$G(^TMP($J,"PSSP130-1",PSSIEN,PSSSYN)),DA(1)=PSSIEN,DA=PSSSYN
..S DIE="^PS(50.7,"_DA(1)_","_2_",",DR=".01////^S X=PSSNM" D ^DIE
..S X="" D TXT($P(^PS(50.7,PSSIEN,0),"^"),1),TXT(PSSIEN,40),TXT(PSSNM,48)
..S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=X
S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=""
D MAIL
;
VAC ; Re_index VAC cross-reference.
S PSSVAC=""
F S PSSVAC=$O(^PSDRUG("VAC",PSSVAC)) Q:'PSSVAC D
.S PSSIEN=""
.F S PSSIEN=$O(^PSDRUG("VAC",PSSVAC,PSSIEN)) Q:'PSSIEN S ^TMP($J,"PSSP130-1",PSSIEN,PSSVAC)=$P(^PS(50.605,PSSVAC,0),"^",1)
S PSSIEN=""
F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
.S PSSCNT=0,PSSVAC=""
.F S PSSVAC=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSVAC)) Q:'PSSVAC S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130-1",PSSIEN)=PSSCNT
S PSSIEN=""
F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN K:$G(^TMP($J,"PSSP130-1",PSSIEN))<2 ^TMP($J,"PSSP130-1",PSSIEN)
F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
.S PSSVAC=""
.F S PSSVAC=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSVAC)) Q:'PSSVAC D
..K:$D(^PSDRUG("VAC",PSSVAC,PSSIEN)) ^PSDRUG("VAC",PSSVAC,PSSIEN)
.S DA=PSSIEN,DIK="^PSDRUG(",DIK(1)="25"
.D EN^DIK K DA,DIK
S XMSUB="PSS*1*130 Re-index the Drugs VAC report"
S ^TMP($J,"PSSP130",1)="PSS*1*130 Re-index - VAC - Drugs to VA Drug Class"
S ^TMP($J,"PSSP130",2)="The following Drug(s) had multiple VAC indexs"
S ^TMP($J,"PSSP130",3)=""
I '$D(^TMP($J,"PSSP130-1")) S ^TMP($J,"PSSP130",4)="No multiple indexs found.",^TMP($J,"PSSP130",5)="",PSSCNT=5 G MAIL
S X="" D TXT("-- VA Drug Class --",50)
S ^TMP($J,"PSSP130",4)=X
S X="" D TXT("Drug Name",1),TXT("DRG#",40),TXT("Multiple",48),TXT("Re-indexed",61)
S ^TMP($J,"PSSP130",5)=X
S PSSIEN="",PSSCNT=5
F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
.S X="" D TXT($P(^PSDRUG(PSSIEN,0),"^",1),1),TXT(PSSIEN,40)
.S PSSVAC="",PSSFLG=0
.F S PSSVAC=$O(^PSDRUG("VAC",PSSVAC)) Q:'PSSVAC D
..S:$D(^PSDRUG("VAC",PSSVAC,PSSIEN)) ^TMP($J,"PSSP130-1",PSSIEN)=$P(^PS(50.605,PSSVAC,0),"^",1)
.S PSSVACO="" F S PSSVACO=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSVACO)) Q:'PSSVACO D
..D TXT($G(^TMP($J,"PSSP130-1",PSSIEN,PSSVACO)),50) D:'PSSFLG TXT($G(^TMP($J,"PSSP130-1",PSSIEN)),64)
..S PSSFLG=1,PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=X,X=""
.S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=""
MAIL N DIFROM
S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)="***** End Of Report *****"
S XMTEXT="^TMP($J,""PSSP130"",",XMDUZ="PSS*1*130 Post Install"
S XMY(DUZ)=""
D ^XMD
EXIT ; CLEAN UP
K ^TMP($J),PSSCNT,PSSFLG,PSSIEN,PSSVAC,PSSVACO,XMDUZ,XMSUB,XMTEXT,XMY,PSSSYN,PSSNM,PSSLEN,PSSNAM
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[HPSSP130 4086 printed Dec 13, 2024@02:33:33 Page 2
PSSP130 ;BIR/RJS-REINDEX "VAC" X-REFERENCE ON DRUG FILE (#50)
+1 ;;1.0; PHARMACY DATA MANAGEMENT;**130**;9/30/97;Build 6
+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 ;;
SYN ;Remove the un wanted spaces from the Pharmacy Orderable Items synonym
+1 NEW X
+2 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^PS(50.7,PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+3 SET PSSSYN=0
FOR
SET PSSSYN=$ORDER(^PS(50.7,PSSIEN,2,PSSSYN))
if 'PSSSYN
QUIT
Begin DoDot:2
+4 SET PSSNM=$GET(^PS(50.7,PSSIEN,2,PSSSYN,0))
+5 SET PSSLEN=$LENGTH(PSSNM)
SET PSSNAM=$$TRIM^XLFSTR(PSSNM,," ")
+6 IF $LENGTH(PSSNAM)<$LENGTH(PSSNM)
SET ^TMP($JOB,"PSSP130-1",PSSIEN,PSSSYN)=PSSNAM
End DoDot:2
End DoDot:1
+7 SET PSSIEN=0
+8 SET XMSUB="PSS*1*130 Pharmacy Orderable Item Synonym Repair Report"
+9 SET ^TMP($JOB,"PSSP130",1)="PSS*1*130 Pharmacy Orderable Item Synonym Repair"
+10 SET ^TMP($JOB,"PSSP130",2)="The following Orderable Items contained leading/trailing spaces"
+11 SET ^TMP($JOB,"PSSP130",3)=""
+12 IF '$DATA(^TMP($JOB,"PSSP130-1"))
SET ^TMP($JOB,"PSSP130",4)="No multiple indexs found."
SET ^TMP($JOB,"PSSP130",5)=""
SET PSSCNT=5
DO MAIL
GOTO VAC
+13 SET X=""
DO TXT("ORDERABLE ITEM",1)
DO TXT("IEN",40)
DO TXT("SYNONYM",48)
+14 SET ^TMP($JOB,"PSSP130",4)=X
SET ^TMP($JOB,"PSSP130",5)=""
SET PSSCNT=5
+15 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+16 SET PSSSYN=0
FOR
SET PSSSYN=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN,PSSSYN))
if 'PSSSYN
QUIT
Begin DoDot:2
+17 NEW DIE,DA,DR
+18 SET PSSNM=$GET(^TMP($JOB,"PSSP130-1",PSSIEN,PSSSYN))
SET DA(1)=PSSIEN
SET DA=PSSSYN
+19 SET DIE="^PS(50.7,"_DA(1)_","_2_","
SET DR=".01////^S X=PSSNM"
DO ^DIE
+20 SET X=""
DO TXT($PIECE(^PS(50.7,PSSIEN,0),"^"),1)
DO TXT(PSSIEN,40)
DO TXT(PSSNM,48)
+21 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP130",PSSCNT)=X
End DoDot:2
End DoDot:1
+22 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP130",PSSCNT)=""
+23 DO MAIL
+24 ;
VAC ; Re_index VAC cross-reference.
+1 SET PSSVAC=""
+2 FOR
SET PSSVAC=$ORDER(^PSDRUG("VAC",PSSVAC))
if 'PSSVAC
QUIT
Begin DoDot:1
+3 SET PSSIEN=""
+4 FOR
SET PSSIEN=$ORDER(^PSDRUG("VAC",PSSVAC,PSSIEN))
if 'PSSIEN
QUIT
SET ^TMP($JOB,"PSSP130-1",PSSIEN,PSSVAC)=$PIECE(^PS(50.605,PSSVAC,0),"^",1)
End DoDot:1
+5 SET PSSIEN=""
+6 FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+7 SET PSSCNT=0
SET PSSVAC=""
+8 FOR
SET PSSVAC=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN,PSSVAC))
if 'PSSVAC
QUIT
SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP130-1",PSSIEN)=PSSCNT
End DoDot:1
+9 SET PSSIEN=""
+10 FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN))
if 'PSSIEN
QUIT
if $GET(^TMP($JOB,"PSSP130-1",PSSIEN))<2
KILL ^TMP($JOB,"PSSP130-1",PSSIEN)
+11 FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+12 SET PSSVAC=""
+13 FOR
SET PSSVAC=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN,PSSVAC))
if 'PSSVAC
QUIT
Begin DoDot:2
+14 if $DATA(^PSDRUG("VAC",PSSVAC,PSSIEN))
KILL ^PSDRUG("VAC",PSSVAC,PSSIEN)
End DoDot:2
+15 SET DA=PSSIEN
SET DIK="^PSDRUG("
SET DIK(1)="25"
+16 DO EN^DIK
KILL DA,DIK
End DoDot:1
+17 SET XMSUB="PSS*1*130 Re-index the Drugs VAC report"
+18 SET ^TMP($JOB,"PSSP130",1)="PSS*1*130 Re-index - VAC - Drugs to VA Drug Class"
+19 SET ^TMP($JOB,"PSSP130",2)="The following Drug(s) had multiple VAC indexs"
+20 SET ^TMP($JOB,"PSSP130",3)=""
+21 IF '$DATA(^TMP($JOB,"PSSP130-1"))
SET ^TMP($JOB,"PSSP130",4)="No multiple indexs found."
SET ^TMP($JOB,"PSSP130",5)=""
SET PSSCNT=5
GOTO MAIL
+22 SET X=""
DO TXT("-- VA Drug Class --",50)
+23 SET ^TMP($JOB,"PSSP130",4)=X
+24 SET X=""
DO TXT("Drug Name",1)
DO TXT("DRG#",40)
DO TXT("Multiple",48)
DO TXT("Re-indexed",61)
+25 SET ^TMP($JOB,"PSSP130",5)=X
+26 SET PSSIEN=""
SET PSSCNT=5
+27 FOR
SET PSSIEN=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+28 SET X=""
DO TXT($PIECE(^PSDRUG(PSSIEN,0),"^",1),1)
DO TXT(PSSIEN,40)
+29 SET PSSVAC=""
SET PSSFLG=0
+30 FOR
SET PSSVAC=$ORDER(^PSDRUG("VAC",PSSVAC))
if 'PSSVAC
QUIT
Begin DoDot:2
+31 if $DATA(^PSDRUG("VAC",PSSVAC,PSSIEN))
SET ^TMP($JOB,"PSSP130-1",PSSIEN)=$PIECE(^PS(50.605,PSSVAC,0),"^",1)
End DoDot:2
+32 SET PSSVACO=""
FOR
SET PSSVACO=$ORDER(^TMP($JOB,"PSSP130-1",PSSIEN,PSSVACO))
if 'PSSVACO
QUIT
Begin DoDot:2
+33 DO TXT($GET(^TMP($JOB,"PSSP130-1",PSSIEN,PSSVACO)),50)
if 'PSSFLG
DO TXT($GET(^TMP($JOB,"PSSP130-1",PSSIEN)),64)
+34 SET PSSFLG=1
SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP130",PSSCNT)=X
SET X=""
End DoDot:2
+35 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP130",PSSCNT)=""
End DoDot:1
MAIL NEW DIFROM
+1 SET PSSCNT=PSSCNT+1
SET ^TMP($JOB,"PSSP130",PSSCNT)="***** End Of Report *****"
+2 SET XMTEXT="^TMP($J,""PSSP130"","
SET XMDUZ="PSS*1*130 Post Install"
+3 SET XMY(DUZ)=""
+4 DO ^XMD
EXIT ; CLEAN UP
+1 KILL ^TMP($JOB),PSSCNT,PSSFLG,PSSIEN,PSSVAC,PSSVACO,XMDUZ,XMSUB,XMTEXT,XMY,PSSSYN,PSSNM,PSSLEN,PSSNAM
+2 QUIT
TXT(VAL,COL) if '$DATA(X)
SET X=""
SET X=$$SETSTR^VALM1(VAL,X,COL,$LENGTH(VAL))
+1 QUIT
