PSSP110.m

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 ---PSSP110   2399     printed  Mar 13, 2025@21:38:06                                                                                                                                                                                                     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