Routine: PSO7P731

PSO7P731 ;DAL/JCH - Post Install routine for patch PSO*7*731 ;08/24/2023

 ;;7.0;OUTPATIENT PHARMACY;**731**;DEC 1997;Build 18

 ; Reference to ^VA(200,IEN,"PS" in ICR #10060

POST ; Post Install queued entry point

 D QUE

START ; Begin post-install processing

 ; Remove orphaned DEAs

 N PSOXNODE

 S PSOXNODE="PSO*7.0*731 POST INSTALL"

 D ORPHANDEA

 D TMPMSG(PSOXNODE)

ORPHANDEA ; Clean up orphaned DEA# field (53.2) in NEW PERSON file (#200)

 N DEA532,DEA5321,PRIEN,PSOFDA,PSOPRGDT,PSOXHDR,PSODTM

 S PSODTM=$$NOW^XLFDT()

 S PSOXHDR=$$FMADD^XLFDT($$DT^XLFDT(),90)_"^"_$$DT^XLFDT()_"^Delete orphan DEA numbers from DEA# field (#53.2) in NEW PERSON file (#200)"

 S ^XTMP(PSOXNODE,0)=$G(PSOXHDR)

 ; Remove Orphan DEA# field (#53.2) values when no NEW DEA #'s multiple (#53.21) values exist for Provider

 ; Find all DEA number in DEA# field (#53.2)

 S DEA532="" F  S DEA532=$O(^VA(200,"PS1",DEA532)) Q:DEA532=""  D

 . ; Find providers associated with DEA# - quit if no NEW DEA #'s were ever filed for the provider

 . S PRIEN=0 F  S PRIEN=$O(^VA(200,"PS1",DEA532,PRIEN)) Q:'PRIEN  D

 . . Q:'$D(^VA(200,PRIEN,"PS4",0))!$O(^VA(200,PRIEN,"PS4",0))

 . . K PSOFDA,PSOERR

 . . S PSOFDA(200,PRIEN_",",53.2)="@"

 . . D FILE^DIE("","PSOFDA","PSOERR")

 . . S ^XTMP(PSOXNODE,"DEA",$G(DEA532),"DELETED",+$G(PRIEN))=PSODTM

 . . S PSOERR=$G(PSOERR("DIERR",1,"TEXT",1)) I $L(PSOERR) S ^XTMP(PSOXNODE,"DEA",$G(DEA532),"ERROR",+$G(PRIEN))=""

 . . Q

. Q

TMPMSG(PSOXNODE)  ; Send MailMan LOG REPORT

 Q:$G(PSOXNODE)=""

 N PSODASH,PSOXMAIL,PSODEA,PSOPRIEN,PSOCNT,PSODEAR,PSOPAD,NPIEN,XMDUZ,XMSUB

 S $P(PSODASH,"-",80)="",$P(PSOPAD," ",80)=" "

 S PSOXMAIL="PSO_ORPHAN_DEA_CLEANUP"

 S XMDUZ=.5

 S XMSUB="Orphan DEA Cleanup Complete "_$$FMTE^XLFDT(DT,"5DZ"),XMDUZ=.5

 K XMY S NPIEN=0 F  S NPIEN=$O(^XUSEC("PSDMGR",NPIEN)) Q:'+NPIEN  S XMY(NPIEN)=""

 S PSOCNT=3  ; Start DEA array starts at 4, first 3 lines for header

 S PSODEA="" F  S PSODEA=$O(^XTMP(PSOXNODE,"DEA",PSODEA)) Q:PSODEA=""  D

 . S PSOPRIEN=0 F  S PSOPRIEN=$O(^XTMP(PSOXNODE,"DEA",PSODEA,"DELETED",PSOPRIEN)) Q:'PSOPRIEN  D

 . . ; Pull Date/Time back out, in case run more than once at different times

 . . S PSODTM=$G(^XTMP(PSOXNODE,"DEA",PSODEA,"DELETED",PSOPRIEN)) S:'$L(PSODTM) PSODTM="*Missing*"

 . . S PSOCNT=PSOCNT+1

 . . S PSODEAR(PSOCNT,0)="  Provider IEN:"_PSOPRIEN

 . . S PSODEAR(PSOCNT,0)=PSODEAR(PSOCNT,0)_$E(PSOPAD,1,31-$L(PSODEAR(PSOCNT,0)))_" DEA: "_PSODEA_"   Removed: "_$P($$FMTE^XLFDT(PSODTM,"2Z"),":",1,2)

 S PSOCNT=PSOCNT-3

 S ^XTMP(PSOXMAIL,$J,1,0)=" Orphan DEA Cleanup Complete"

 S ^XTMP(PSOXMAIL,$J,2,0)=" "_PSOCNT_" orphaned DEA number"_$S(PSOCNT=1:" was ",1:"s were ")_"removed from the NEW PERSON (#200) file"

 S ^XTMP(PSOXMAIL,$J,3,0)=""

 M ^XTMP(PSOXMAIL,$J)=PSODEAR

 S XMY(DUZ)="" N DIFROM S XMTEXT="^XTMP("""_PSOXMAIL_""","_$J_"," D ^XMD K DIFROM

 K PSOTEXT,XMTEXT

 K ^XTMP(PSOXMAIL,$J)

QUE ; Que post install

 N PSOJOB,PSOPATCH,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE

 S PSOPATCH="PSO*7.0*731"

 S ZTDTH=$$FMTH^XLFDT($$NOW^XLFDT())

 S PSOJOB=$J

 S ZTRTN="START^PSO7P731",ZTIO=""

 S (ZTDESC)="Background job for "_PSOJOB

 S ZTSAVE("JOBN")="",ZTSAVE("ZTDTH")="",ZTSAVE("DUZ")=""

 D ^%ZTLOAD

 D:$D(ZTSK)

 . N POSTEXT

 . S POSTEXT(1)="A MailMan message will be sent to the installer and"

 . S POSTEXT(2)="PSDRPH key holders upon Post Install Completion"

 . S POSTEXT(3)="*** Task #"_ZTSK_" Queued! ***"

 . D MES^XPDUTL(.POSTEXT)

 . S ZTSAVE("ZTSK")=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P731   3567     printed  Apr 23, 2025@18:38:28                                                                                                                                                                                                    Page 2

PSO7P731  ;DAL/JCH - Post Install routine for patch PSO*7*731 ;08/24/2023

 +1       ;;7.0;OUTPATIENT PHARMACY;**731**;DEC 1997;Build 18

 +2       ;

 +3       ; Reference to ^VA(200,IEN,"PS" in ICR #10060

 +4        QUIT

 +5       ;

POST      ; Post Install queued entry point

 +1        DO QUE

 +2        QUIT

 +3       ;

START     ; Begin post-install processing

 +1       ; Remove orphaned DEAs

 +2        NEW PSOXNODE

 +3        SET PSOXNODE="PSO*7.0*731 POST INSTALL"

 +4        DO ORPHANDEA

 +5        DO TMPMSG(PSOXNODE)

 +6        QUIT

 +7       ;

ORPHANDEA ; Clean up orphaned DEA# field (53.2) in NEW PERSON file (#200)

 +1        NEW DEA532,DEA5321,PRIEN,PSOFDA,PSOPRGDT,PSOXHDR,PSODTM

 +2        SET PSODTM=$$NOW^XLFDT()

 +3        SET PSOXHDR=$$FMADD^XLFDT($$DT^XLFDT(),90)_"^"_$$DT^XLFDT()_"^Delete orphan DEA numbers from DEA# field (#53.2) in NEW PERSON file (#200)"

 +4        SET ^XTMP(PSOXNODE,0)=$GET(PSOXHDR)

 +5       ;

 +6       ; Remove Orphan DEA# field (#53.2) values when no NEW DEA #'s multiple (#53.21) values exist for Provider

 +7       ; Find all DEA number in DEA# field (#53.2)

 +8        SET DEA532=""

FOR

               SET DEA532=$ORDER(^VA(200,"PS1",DEA532))

               if DEA532=""

                   QUIT

               Begin DoDot:1

 +9       ; Find providers associated with DEA# - quit if no NEW DEA #'s were ever filed for the provider

 +10               SET PRIEN=0

FOR

                       SET PRIEN=$ORDER(^VA(200,"PS1",DEA532,PRIEN))

                       if 'PRIEN

                           QUIT

                       Begin DoDot:2

 +11                       if '$DATA(^VA(200,PRIEN,"PS4",0))!$ORDER(^VA(200,PRIEN,"PS4",0))

                               QUIT

 +12                       KILL PSOFDA,PSOERR

 +13                       SET PSOFDA(200,PRIEN_",",53.2)="@"

 +14                       DO FILE^DIE("","PSOFDA","PSOERR")

 +15                       SET ^XTMP(PSOXNODE,"DEA",$GET(DEA532),"DELETED",+$GET(PRIEN))=PSODTM

 +16                       SET PSOERR=$GET(PSOERR("DIERR",1,"TEXT",1))

                           IF $LENGTH(PSOERR)

                               SET ^XTMP(PSOXNODE,"DEA",$GET(DEA532),"ERROR",+$GET(PRIEN))=""

 +17                       QUIT

                       End DoDot:2

 +18               QUIT

               End DoDot:1

 +19       QUIT

 +20      ;

TMPMSG(PSOXNODE) ; Send MailMan LOG REPORT

 +1        if $GET(PSOXNODE)=""

               QUIT

 +2        NEW PSODASH,PSOXMAIL,PSODEA,PSOPRIEN,PSOCNT,PSODEAR,PSOPAD,NPIEN,XMDUZ,XMSUB

 +3        SET $PIECE(PSODASH,"-",80)=""

           SET $PIECE(PSOPAD," ",80)=" "

 +4        SET PSOXMAIL="PSO_ORPHAN_DEA_CLEANUP"

 +5        SET XMDUZ=.5

 +6       ;

 +7        SET XMSUB="Orphan DEA Cleanup Complete "_$$FMTE^XLFDT(DT,"5DZ")

           SET XMDUZ=.5

 +8        KILL XMY

           SET NPIEN=0

FOR

               SET NPIEN=$ORDER(^XUSEC("PSDMGR",NPIEN))

               if '+NPIEN

                   QUIT

               SET XMY(NPIEN)=""

 +9       ;

 +10      ; Start DEA array starts at 4, first 3 lines for header

           SET PSOCNT=3

 +11       SET PSODEA=""

FOR

               SET PSODEA=$ORDER(^XTMP(PSOXNODE,"DEA",PSODEA))

               if PSODEA=""

                   QUIT

               Begin DoDot:1

 +12               SET PSOPRIEN=0

FOR

                       SET PSOPRIEN=$ORDER(^XTMP(PSOXNODE,"DEA",PSODEA,"DELETED",PSOPRIEN))

                       if 'PSOPRIEN

                           QUIT

                       Begin DoDot:2

 +13      ; Pull Date/Time back out, in case run more than once at different times

 +14                       SET PSODTM=$GET(^XTMP(PSOXNODE,"DEA",PSODEA,"DELETED",PSOPRIEN))

                           if '$LENGTH(PSODTM)

                               SET PSODTM="*Missing*"

 +15                       SET PSOCNT=PSOCNT+1

 +16                       SET PSODEAR(PSOCNT,0)="  Provider IEN:"_PSOPRIEN

 +17                       SET PSODEAR(PSOCNT,0)=PSODEAR(PSOCNT,0)_$EXTRACT(PSOPAD,1,31-$LENGTH(PSODEAR(PSOCNT,0)))_" DEA: "_PSODEA_"   Removed: "_$PIECE($$FMTE^XLFDT(PSODTM,"2Z"),":",1,2)

                       End DoDot:2

               End DoDot:1

 +18       SET PSOCNT=PSOCNT-3

 +19      ;

 +20       SET ^XTMP(PSOXMAIL,$JOB,1,0)=" Orphan DEA Cleanup Complete"

 +21       SET ^XTMP(PSOXMAIL,$JOB,2,0)=" "_PSOCNT_" orphaned DEA number"_$SELECT(PSOCNT=1:" was ",1:"s were ")_"removed from the NEW PERSON (#200) file"

 +22       SET ^XTMP(PSOXMAIL,$JOB,3,0)=""

 +23       MERGE ^XTMP(PSOXMAIL,$JOB)=PSODEAR

 +24      ;

 +25       SET XMY(DUZ)=""

           NEW DIFROM

           SET XMTEXT="^XTMP("""_PSOXMAIL_""","_$JOB_","

           DO ^XMD

           KILL DIFROM

 +26       KILL PSOTEXT,XMTEXT

 +27       KILL ^XTMP(PSOXMAIL,$JOB)

 +28       QUIT

 +29      ;

QUE       ; Que post install

 +1        NEW PSOJOB,PSOPATCH,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE

 +2        SET PSOPATCH="PSO*7.0*731"

 +3        SET ZTDTH=$$FMTH^XLFDT($$NOW^XLFDT())

 +4        SET PSOJOB=$JOB

 +5       ;

 +6        SET ZTRTN="START^PSO7P731"

           SET ZTIO=""

 +7        SET (ZTDESC)="Background job for "_PSOJOB

 +8        SET ZTSAVE("JOBN")=""

           SET ZTSAVE("ZTDTH")=""

           SET ZTSAVE("DUZ")=""

 +9        DO ^%ZTLOAD

 +10       if $DATA(ZTSK)

               Begin DoDot:1

 +11               NEW POSTEXT

 +12               SET POSTEXT(1)="A MailMan message will be sent to the installer and"

 +13               SET POSTEXT(2)="PSDRPH key holders upon Post Install Completion"

 +14               SET POSTEXT(3)="*** Task #"_ZTSK_" Queued! ***"

 +15               DO MES^XPDUTL(.POSTEXT)

 +16               SET ZTSAVE("ZTSK")=""

               End DoDot:1

 +17      ;

 +18       QUIT

PSO7P731.m