- 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 Feb 18, 2025@23:59:35 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
