PSN4P69P ;BIR/DMA-post install routine to clean up data ;31 Aug 99 / 11:32 AM
 ;;4.0; NATIONAL DRUG FILE;**69**; 30 Oct 98
 ;
 ; Reference to ^PSDRUG supported by DBIA #2192
 ;
 N DA,DIE,DR,IND,LINE,NA,PR,X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
 ;NOW UPDATE LOCAL DRUG FILE
 K ^TMP($J),^TMP("PSN",$J)
 S DA=0 F  S DA=$O(^PSDRUG(DA)) Q:'DA  S PR=+$P($G(^(DA,"ND")),"^",3) I PR D
 .I $P($G(^PSDRUG(DA,3)),"^"),'$P($G(^PSNDF(50.68,PR,1)),"^",3) S DIE=50,DR="213////0;" D ^DIE K DIE,DR S IND=$O(^PSDRUG(DA,4," "),-1),$P(^(IND,0),"^",6)="NDF Update",^TMP($J,$P(^PSDRUG(DA,0),"^"))=""
 ;
 K ^TMP("PSN",$J) F LINE=1:1 S X=$P($T(TEXT+LINE),";",3,300) Q:X=""  S ^TMP("PSN",$J,LINE,0)=X
 S NA="" F LINE=LINE:1 S NA=$O(^TMP($J,NA)) Q:NA=""  S ^TMP("PSN",$J,LINE,0)=NA
 I '$D(^TMP($J)) S ^TMP("PSN",$J,LINE,0)="No items were found."
 S XMDUZ="NDF MANAGER",XMSUB="DRUGS UNMARKED FOR CMOP",XMTEXT="^TMP(""PSN"",$J,"
 K XMY S XMY("G.NDF DATA@"_^XMB("NETNAME"))=""
 S DA=0 F  S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA  S XMY(DA)=""
 I $D(DUZ) S XMY(DUZ)=""
 N DIFROM D ^XMD
 K DA,DIE,DR,IND,LINE,NA,PR,X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,^TMP($J),^TMP("PSN",$J)
 Q
 ;
TEXT ;; 
 ;;The following items in your DRUG file (#50) have been unmarked for
 ;;CMOP because they are matched to entries in the VA PRODUCT file (#50.68)
 ;;which had previously been unmarked for CMOP.
 ;; 
 ;;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN4P69P   1367     printed  Sep 23, 2025@19:58:18                                                                                                                                                                                                    Page 2
PSN4P69P  ;BIR/DMA-post install routine to clean up data ;31 Aug 99 / 11:32 AM
 +1       ;;4.0; NATIONAL DRUG FILE;**69**; 30 Oct 98
 +2       ;
 +3       ; Reference to ^PSDRUG supported by DBIA #2192
 +4       ;
 +5        NEW DA,DIE,DR,IND,LINE,NA,PR,X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
 +6       ;NOW UPDATE LOCAL DRUG FILE
 +7        KILL ^TMP($JOB),^TMP("PSN",$JOB)
 +8        SET DA=0
           FOR 
               SET DA=$ORDER(^PSDRUG(DA))
               if 'DA
                   QUIT 
               SET PR=+$PIECE($GET(^(DA,"ND")),"^",3)
               IF PR
                   Begin DoDot:1
 +9                    IF $PIECE($GET(^PSDRUG(DA,3)),"^")
                           IF '$PIECE($GET(^PSNDF(50.68,PR,1)),"^",3)
                               SET DIE=50
                               SET DR="213////0;"
                               DO ^DIE
                               KILL DIE,DR
                               SET IND=$ORDER(^PSDRUG(DA,4," "),-1)
                               SET $PIECE(^(IND,0),"^",6)="NDF Update"
                               SET ^TMP($JOB,$PIECE(^PSDRUG(DA,0),"^"))=""
                   End DoDot:1
 +10      ;
 +11       KILL ^TMP("PSN",$JOB)
           FOR LINE=1:1
               SET X=$PIECE($TEXT(TEXT+LINE),";",3,300)
               if X=""
                   QUIT 
               SET ^TMP("PSN",$JOB,LINE,0)=X
 +12       SET NA=""
           FOR LINE=LINE:1
               SET NA=$ORDER(^TMP($JOB,NA))
               if NA=""
                   QUIT 
               SET ^TMP("PSN",$JOB,LINE,0)=NA
 +13       IF '$DATA(^TMP($JOB))
               SET ^TMP("PSN",$JOB,LINE,0)="No items were found."
 +14       SET XMDUZ="NDF MANAGER"
           SET XMSUB="DRUGS UNMARKED FOR CMOP"
           SET XMTEXT="^TMP(""PSN"",$J,"
 +15       KILL XMY
           SET XMY("G.NDF DATA@"_^XMB("NETNAME"))=""
 +16       SET DA=0
           FOR 
               SET DA=$ORDER(^XUSEC("PSNMGR",DA))
               if 'DA
                   QUIT 
               SET XMY(DA)=""
 +17       IF $DATA(DUZ)
               SET XMY(DUZ)=""
 +18       NEW DIFROM
           DO ^XMD
 +19       KILL DA,DIE,DR,IND,LINE,NA,PR,X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,^TMP($JOB),^TMP("PSN",$JOB)
 +20       QUIT 
 +21      ;
TEXT      ;; 
 +1       ;;The following items in your DRUG file (#50) have been unmarked for
 +2       ;;CMOP because they are matched to entries in the VA PRODUCT file (#50.68)
 +3       ;;which had previously been unmarked for CMOP.
 +4       ;; 
 +5       ;;