- 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 Mar 13, 2025@21:38:09 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
