PSO7P478.m

PSO7P478 ;AITC/PD - Post-install for PSO*7*478 ;6/15/2017

 ;;7.0;OUTPATIENT PHARMACY;**478**;;Build 27

 ; Reference to BPSNCPD3 supported by IA 4560

 ;

 Q

 ;

POST ; Post-install functions are coded here.

 ;

 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK

 ;

 D BMES^XPDUTL("  Queuing background job to update REJECT INFO sub-file of the PRESCRIPTION")

 D MES^XPDUTL("  file. A Mailman message will be sent upon completion.")

 ;

 ; Setup required variables

 S ZTRTN="PCN^PSO7P478"

 S ZTIO=""

 S ZTDTH=$H

 S ZTDESC="Background job to update REJECT INFO sub-file for PSO*7*478"

 ;

 ; Task the job

 D ^%ZTLOAD

 ;

 ; Check if task was created

 I $D(ZTSK) D MES^XPDUTL("  Task #"_ZTSK_" queued.")

 I '$D(ZTSK) D MES^XPDUTL("  Task not queued. Please create a support ticket.")

 ;

 Q

 ;

PCN ;Update PCN on PRESCRIPTION reject multiple

 ;

 N CNT,COB,DAT,DUR,RX,RN,RSPIEN,DA,DR,DIE

 S CNT=0

 S DAT=0 F  S DAT=$O(^PSRX("REJDAT",DAT)) Q:'DAT  D

 . S RX="" F  S RX=$O(^PSRX("REJDAT",DAT,RX)) Q:'RX  D

 .. S RN="" F  S RN=$O(^PSRX("REJDAT",DAT,RX,RN)) Q:'RN  D

 ... I $P($G(^PSRX(RX,"REJ",RN,2)),"^",10)'="" Q

 ... S RSPIEN=$P($G(^PSRX(RX,"REJ",RN,0)),"^",11) I 'RSPIEN Q

 ... S COB=$P($G(^PSRX(RX,"REJ",RN,2)),"^",7) I COB="" S COB=1

 ... K DUR D DURRESP^BPSNCPD3(RSPIEN,.DUR,COB)     ; ICR# 4560

 ... I $L(DUR(COB,"PCN"))'=10 Q

 ... S DIE="^PSRX("_RX_",""REJ"",",DA(1)=RX,DA=RN,DR=34_"////"_DUR(COB,"PCN")

 ... D ^DIE K DA,DR,DIE

 ... S CNT=CNT+1

 ;

 D MAIL(CNT)  ; Send mail message

 Q

 ;

MAIL(PCNCNT) ; Send mail message

 N CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT

 S XMY(DUZ)=""

 S XMSUB="PSO*7.0*478 Post install is complete",XMDUZ="Patch PSO*7.0*478"

 S XMTEXT="MSG("

 S CNT=1,MSG(CNT)=""

 S CNT=CNT+1,MSG(CNT)="Patch PSO*7.0*478 post install routine has completed."

 S CNT=CNT+1,MSG(CNT)=""

 S CNT=CNT+1,MSG(CNT)="Updated "_PCNCNT_" records in the REJECT INFO sub-file of the PRESCRIPTION file."

 S CNT=CNT+1,MSG(CNT)=""

 S CNT=CNT+1,MSG(CNT)="For more information about this post install, review the patch description."

 D ^XMD

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO7P478   2068     printed  Mar 13, 2025@21:28:45                                                                                                                                                                                                    Page 2

PSO7P478  ;AITC/PD - Post-install for PSO*7*478 ;6/15/2017

 +1       ;;7.0;OUTPATIENT PHARMACY;**478**;;Build 27

 +2       ; Reference to BPSNCPD3 supported by IA 4560

 +3       ;

 +4        QUIT 

 +5       ;

POST      ; Post-install functions are coded here.

 +1       ;

 +2        NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK

 +3       ;

 +4        DO BMES^XPDUTL("  Queuing background job to update REJECT INFO sub-file of the PRESCRIPTION")

 +5        DO MES^XPDUTL("  file. A Mailman message will be sent upon completion.")

 +6       ;

 +7       ; Setup required variables

 +8        SET ZTRTN="PCN^PSO7P478"

 +9        SET ZTIO=""

 +10       SET ZTDTH=$HOROLOG

 +11       SET ZTDESC="Background job to update REJECT INFO sub-file for PSO*7*478"

 +12      ;

 +13      ; Task the job

 +14       DO ^%ZTLOAD

 +15      ;

 +16      ; Check if task was created

 +17       IF $DATA(ZTSK)

               DO MES^XPDUTL("  Task #"_ZTSK_" queued.")

 +18       IF '$DATA(ZTSK)

               DO MES^XPDUTL("  Task not queued. Please create a support ticket.")

 +19      ;

 +20       QUIT 

 +21      ;

PCN       ;Update PCN on PRESCRIPTION reject multiple

 +1       ;

 +2        NEW CNT,COB,DAT,DUR,RX,RN,RSPIEN,DA,DR,DIE

 +3        SET CNT=0

 +4        SET DAT=0

           FOR 

               SET DAT=$ORDER(^PSRX("REJDAT",DAT))

               if 'DAT

                   QUIT 

               Begin DoDot:1

 +5                SET RX=""

                   FOR 

                       SET RX=$ORDER(^PSRX("REJDAT",DAT,RX))

                       if 'RX

                           QUIT 

                       Begin DoDot:2

 +6                        SET RN=""

                           FOR 

                               SET RN=$ORDER(^PSRX("REJDAT",DAT,RX,RN))

                               if 'RN

                                   QUIT 

                               Begin DoDot:3

 +7                                IF $PIECE($GET(^PSRX(RX,"REJ",RN,2)),"^",10)'=""

                                       QUIT 

 +8                                SET RSPIEN=$PIECE($GET(^PSRX(RX,"REJ",RN,0)),"^",11)

                                   IF 'RSPIEN

                                       QUIT 

 +9                                SET COB=$PIECE($GET(^PSRX(RX,"REJ",RN,2)),"^",7)

                                   IF COB=""

                                       SET COB=1

 +10      ; ICR# 4560

                                   KILL DUR

                                   DO DURRESP^BPSNCPD3(RSPIEN,.DUR,COB)

 +11                               IF $LENGTH(DUR(COB,"PCN"))'=10

                                       QUIT 

 +12                               SET DIE="^PSRX("_RX_",""REJ"","

                                   SET DA(1)=RX

                                   SET DA=RN

                                   SET DR=34_"////"_DUR(COB,"PCN")

 +13                               DO ^DIE

                                   KILL DA,DR,DIE

 +14                               SET CNT=CNT+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15      ;

 +16      ; Send mail message

           DO MAIL(CNT)

 +17       QUIT 

 +18      ;

MAIL(PCNCNT) ; Send mail message

 +1        NEW CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT

 +2        SET XMY(DUZ)=""

 +3        SET XMSUB="PSO*7.0*478 Post install is complete"

           SET XMDUZ="Patch PSO*7.0*478"

 +4        SET XMTEXT="MSG("

 +5        SET CNT=1

           SET MSG(CNT)=""

 +6        SET CNT=CNT+1

           SET MSG(CNT)="Patch PSO*7.0*478 post install routine has completed."

 +7        SET CNT=CNT+1

           SET MSG(CNT)=""

 +8        SET CNT=CNT+1

           SET MSG(CNT)="Updated "_PCNCNT_" records in the REJECT INFO sub-file of the PRESCRIPTION file."

 +9        SET CNT=CNT+1

           SET MSG(CNT)=""

 +10       SET CNT=CNT+1

           SET MSG(CNT)="For more information about this post install, review the patch description."

 +11       DO ^XMD

 +12       QUIT