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 ---[H[J[2J[HPSO7P478 2068 printed Apr 09, 2024@21:26:12 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
