PSSP110 ; Post init routine for patch PSS*1*110 03/30/2006 4:57P
;;1.0;PHARMACY DATA MANAGEMENT;**110**;9/30/97
Q
EN ; Entry point
; Convert the NAME field in files #51 & 51.1 to all CAPS
;
N DD,D0,DA,DIE,DR,PSSI,PSSJ,PSSCNT,PSSTXT,PSSLN,PSSAST
N XMDUZ,XMSUB,XMTEXT,XMY,DIFROM,PSSFLG
I $G(U)="" S U="^"
S XMDUZ="PSS*1*110 Post Init",XMY(DUZ)=""
;
; File 51 (Medication Instruction)
S DIE="^PS(51,"
D CON
S XMSUB="File #51 modified records"
D MSG1
;
; File 51.1 (Administration Schedule)
S DIE="^PS(51.1,"
D CON
S XMSUB="File #51.1 modified records"
D MSG1
;
; File 51.2 (Medication Routes)
;S XMSUB="File #51.2 'to be' modified records"
;D COM
G ENQ
;
CON ; Convert ONLY lowercase alphabet to uppercase. All other characters
; in the NAME field are left alone.
S PSSI="",PSSCNT=0,PSSLN=2,PSSFLG=""
F S PSSI=$O(@(DIE_"""B"""_",PSSI)")) Q:PSSI="" D
. I PSSI'?.E1L.E Q ; No lowercase in the NAME, no need to convert
. S PSSJ=$$UP^XLFSTR(PSSI),PSSAST="*"
. I '$O(@(DIE_"""B"""_",PSSJ,0)")) D
. . S DA=$O(@(DIE_"""B"""_",PSSI,0)")),DR=".01///"_PSSJ
. . D ^DIE
. . S PSSAST=""
. E S PSSFLG=1
. S PSSCNT=PSSCNT+1
. S PSSLN=PSSLN+1,PSSTXT(PSSLN)=PSSAST_PSSI
Q
COM ; Compile a list of all medication routes that do NOT
; have an abbreviation and send it to DUZ.
S PSSI="",PSSCNT=0,PSSLN=2
F S PSSI=$O(^PS(51.2,PSSI)) Q:PSSI']"" D
. I '$D(^PS(51.2,PSSI,0)) Q
. S PSSJ=$G(^PS(51.2,PSSI,0))
. I $P(PSSJ,U,3)']"" D
. . S PSSCNT=PSSCNT+1,PSSLN=PSSLN+1
. . S PSSTXT(PSSLN)=$P(PSSJ,U,1)
I PSSCNT<1 D Q
. S PSSTXT(1)="All medication routes have abbreviations!"
. D SEND
S PSSTXT(1)="The following medication route/s does/do not"
S PSSTXT(2)="have a corresponding abbreviation:"
D SEND
Q
MSG1 ; Send message to user DUZ for files 51 & 51.1
I PSSCNT<1 D Q
. S PSSTXT(1)="No NAME conversion was neccessary!"
. D SEND
S PSSTXT(1)="The following NAME/s was/were converted"
S PSSTXT(2)="from lowercase to uppercase:"
I PSSFLG=1 D
. S PSSLN=PSSLN+1
. S PSSTXT(PSSLN)="Record/s marked with an '*' was/were skipped."
. S PSSLN=PSSLN+1
. S PSSTXT(PSSLN)="Conversion to uppercase would have created a"
. S PSSLN=PSSLN+1
. S PSSTXT(PSSLN)="duplicate NAME. Please check!!"
D SEND
Q
SEND ;
S XMTEXT="PSSTXT(",XMDUZ="PSS*1*110 Post Init",XMY(DUZ)=""
D ^XMD
K PSSTXT
ENQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP110 2399 printed Dec 13, 2024@02:33:32 Page 2
PSSP110 ; Post init routine for patch PSS*1*110 03/30/2006 4:57P
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**110**;9/30/97
+2 QUIT
EN ; Entry point
+1 ; Convert the NAME field in files #51 & 51.1 to all CAPS
+2 ;
+3 NEW DD,D0,DA,DIE,DR,PSSI,PSSJ,PSSCNT,PSSTXT,PSSLN,PSSAST
+4 NEW XMDUZ,XMSUB,XMTEXT,XMY,DIFROM,PSSFLG
+5 IF $GET(U)=""
SET U="^"
+6 SET XMDUZ="PSS*1*110 Post Init"
SET XMY(DUZ)=""
+7 ;
+8 ; File 51 (Medication Instruction)
+9 SET DIE="^PS(51,"
+10 DO CON
+11 SET XMSUB="File #51 modified records"
+12 DO MSG1
+13 ;
+14 ; File 51.1 (Administration Schedule)
+15 SET DIE="^PS(51.1,"
+16 DO CON
+17 SET XMSUB="File #51.1 modified records"
+18 DO MSG1
+19 ;
+20 ; File 51.2 (Medication Routes)
+21 ;S XMSUB="File #51.2 'to be' modified records"
+22 ;D COM
+23 GOTO ENQ
+24 ;
CON ; Convert ONLY lowercase alphabet to uppercase. All other characters
+1 ; in the NAME field are left alone.
+2 SET PSSI=""
SET PSSCNT=0
SET PSSLN=2
SET PSSFLG=""
+3 FOR
SET PSSI=$ORDER(@(DIE_"""B"""_",PSSI)"))
if PSSI=""
QUIT
Begin DoDot:1
+4 ; No lowercase in the NAME, no need to convert
IF PSSI'?.E1L.E
QUIT
+5 SET PSSJ=$$UP^XLFSTR(PSSI)
SET PSSAST="*"
+6 IF '$ORDER(@(DIE_"""B"""_",PSSJ,0)"))
Begin DoDot:2
+7 SET DA=$ORDER(@(DIE_"""B"""_",PSSI,0)"))
SET DR=".01///"_PSSJ
+8 DO ^DIE
+9 SET PSSAST=""
End DoDot:2
+10 IF '$TEST
SET PSSFLG=1
+11 SET PSSCNT=PSSCNT+1
+12 SET PSSLN=PSSLN+1
SET PSSTXT(PSSLN)=PSSAST_PSSI
End DoDot:1
+13 QUIT
COM ; Compile a list of all medication routes that do NOT
+1 ; have an abbreviation and send it to DUZ.
+2 SET PSSI=""
SET PSSCNT=0
SET PSSLN=2
+3 FOR
SET PSSI=$ORDER(^PS(51.2,PSSI))
if PSSI']""
QUIT
Begin DoDot:1
+4 IF '$DATA(^PS(51.2,PSSI,0))
QUIT
+5 SET PSSJ=$GET(^PS(51.2,PSSI,0))
+6 IF $PIECE(PSSJ,U,3)']""
Begin DoDot:2
+7 SET PSSCNT=PSSCNT+1
SET PSSLN=PSSLN+1
+8 SET PSSTXT(PSSLN)=$PIECE(PSSJ,U,1)
End DoDot:2
End DoDot:1
+9 IF PSSCNT<1
Begin DoDot:1
+10 SET PSSTXT(1)="All medication routes have abbreviations!"
+11 DO SEND
End DoDot:1
QUIT
+12 SET PSSTXT(1)="The following medication route/s does/do not"
+13 SET PSSTXT(2)="have a corresponding abbreviation:"
+14 DO SEND
+15 QUIT
MSG1 ; Send message to user DUZ for files 51 & 51.1
+1 IF PSSCNT<1
Begin DoDot:1
+2 SET PSSTXT(1)="No NAME conversion was neccessary!"
+3 DO SEND
End DoDot:1
QUIT
+4 SET PSSTXT(1)="The following NAME/s was/were converted"
+5 SET PSSTXT(2)="from lowercase to uppercase:"
+6 IF PSSFLG=1
Begin DoDot:1
+7 SET PSSLN=PSSLN+1
+8 SET PSSTXT(PSSLN)="Record/s marked with an '*' was/were skipped."
+9 SET PSSLN=PSSLN+1
+10 SET PSSTXT(PSSLN)="Conversion to uppercase would have created a"
+11 SET PSSLN=PSSLN+1
+12 SET PSSTXT(PSSLN)="duplicate NAME. Please check!!"
End DoDot:1
+13 DO SEND
+14 QUIT
SEND ;
+1 SET XMTEXT="PSSTXT("
SET XMDUZ="PSS*1*110 Post Init"
SET XMY(DUZ)=""
+2 DO ^XMD
+3 KILL PSSTXT
ENQ QUIT
