PSNCFINQ ;BIR/PC - Control File Inquiry Screen ;01/30/2017
 ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
 ;
 N PSNCFBEG,PSNCFEND,PSNCFB,PSNCFE,PSNCFIEN,CNT,PSNCFAX
 K DIC,DIR
ASK ;ask if Download or Install Inquiry
 S (PSNCFOUT,PSNCFQ)=0,PSNCFPG=1,$P(PSNCFLIN,"-",78)=""
 W ! K DIR,Y S DIR(0)="SA^D:DOWNLOAD;I:INSTALL;Q:QUIT"
 S DIR("A")="Select (D)ownload Detail, (I)nstall Detail or (Q)uit: "
 D ^DIR I Y="Q"!$D(DIRUT) G END
 S PSNCFAX=Y
 D DATE I PSNCFQ=1 G END
ASK1 ;
 D @$S(PSNCFAX="I":"ISUM",1:"DSUM") I PSNCFQ=1 G ASK
 D CHOOSE I PSNCFQ=1!($D(DIRUT)) G ASK
 K PSNCFAR D GETS^DIQ(57.23,1,".01;1;2;3;5;6;8;9;10","E","PSNCFAR") ;ZERO level
 S PSNINNM=$S(PSNCFAX="I":$$GET1^DIQ(57.231,PSNCFIEN_",1,",.01,"E"),1:$$GET1^DIQ(57.234,PSNCFIEN_",1,",.01,"E"))
 I PSNCFAX="I" D INSTALL S PSNCFQ=0 G ASK1
 I PSNCFAX="D" D DOWNLD,CONT G ASK1
 Q
DATE ;enter date range for list of .DAT files
 N %DT,X K PSNDT
 S %DT(0)=-DT,%DT="AEP",%DT("A")="Enter Start Date: " W ! D ^%DT I Y<0!($D(DTOUT)) S PSNCFQ=1 Q
 S PSNCFBEG=Y\1-.00001,PSNCFB=Y
 S %DT(0)=PSNCFBEG+1\1,%DT("A")="Enter End Date: " W ! D ^%DT I Y<0!($D(DTOUT)) S PSNCFQ=1 Q
 S PSNCFEND=Y\1+.99999,PSNCFE=Y
 S PSNCFL2=$$FMTE^XLFDT(PSNCFB)_" to "_$$FMTE^XLFDT(PSNCFE)
 S PSNCFOUT=0,PSNCFDEV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSNCFPG=1
 Q
 ;
ISUM ; SUMMARY SCREEN FOR INSTALL FILES
 K PSNX1,PSNCARR S PSNCFPG=1,PSNJ=""
 D HEAD S CNT=0,PSNCFOUT=0
 I '$D(PSNDT) S PSNX1=PSNCFBEG F  S PSNX1=$O(^PS(57.23,1,5,"C",PSNX1)) Q:PSNX1=""!(PSNX1>PSNCFEND)  F  S PSNJ=$O(^PS(57.23,1,5,"C",PSNX1,PSNJ)) Q:PSNJ=""  S PSNDT(PSNJ)=PSNX1
 S PSNCFIEN=0 F  S PSNCFIEN=$O(PSNDT(PSNCFIEN)) Q:PSNCFIEN=""  D GETS^DIQ(57.231,PSNCFIEN_",1",".01;1;2","E","PSNCARR") D  Q:PSNCFOUT=1
 . S CNT=CNT+1,PSNCFSM(CNT)=PSNCFIEN_"^"_PSNCARR(57.231,PSNCFIEN_",1,",.01,"E")
 . W !,"("_CNT_") ",PSNCARR(57.231,PSNCFIEN_",1,",.01,"E"),?32,PSNCARR(57.231,PSNCFIEN_",1,",1,"E"),?55,PSNCARR(57.231,PSNCFIEN_",1,",2,"E")
 . I ($Y+5)>IOSL D HEAD Q:PSNCFOUT=1
 W !! I CNT=0 W !!,"No Install files for date range chosen.  Please enter new dates.",$C(7) W ! D CONT S PSNCFQ=1
 Q
 ;
DSUM ; SUMMARY SCREEN FOR DOWNLOAD FILES
 K PSNX1,PSNCARD S PSNCFPG=1,PSNJ=""
 D HEAD S CNT=0,PSNCFOUT=0
 I '$D(PSNDT) S PSNX1=PSNCFBEG F  S PSNX1=$O(^PS(57.23,1,4,"D",PSNX1)) Q:PSNX1=""!(PSNX1>PSNCFEND)  F  S PSNJ=$O(^PS(57.23,1,4,"D",PSNX1,PSNJ)) Q:PSNJ=""  S PSNDT(PSNJ)=PSNX1
 S PSNCFIEN=0 F  S PSNCFIEN=$O(PSNDT(PSNCFIEN)) Q:PSNCFIEN=""  D GETS^DIQ(57.234,PSNCFIEN_",1",".01;1;2","E","PSNCARD") D  Q:PSNCFOUT=1
 . S CNT=CNT+1,PSNCFSM(CNT)=PSNCFIEN_"^"_PSNCARD(57.234,PSNCFIEN_",1,",.01,"E")
 . W !,"("_CNT_") ",PSNCARD(57.234,PSNCFIEN_",1,",.01,"E"),?32,PSNCARD(57.234,PSNCFIEN_",1,",1,"E"),?55,PSNCARD(57.234,PSNCFIEN_",1,",2,"E")
 . I ($Y+5)>IOSL D HEAD Q:PSNCFOUT=1
 W !! I CNT=0 W !!,"No Download files for date range chosen.  Please enter new dates.",$C(7) W ! D CONT S PSNCFQ=1
 Q
 ;
HEAD ; SUMMARY HEADER PAGE
 I $G(PSNCFPG)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSNCFOUT=1 Q
 W @IOF
 W !,$S(PSNCFAX="D":"DOWNLOAD",1:"INSTALL")_" FILE NAME",?32,$S(PSNCFAX="D":"DOWNLOAD",1:"INSTALL")_" BEGIN DT/TM",?55,"COMPLETION DT/TM"
 W !,PSNCFL2,?68,"PAGE: "_PSNCFPG,!,PSNCFLIN S PSNCFPG=PSNCFPG+1
 Q
 ;
HEAD1(PSNH) ; DETAIL HEADER PAGE
 ;PSNP = DETAIL OR ERROR
 I $G(PSNCFPG)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSNCFQ=1 Q
 W @IOF
 W !,PSNH_" INFORMATION FOR FILE "_PSNINNM
 W !,?68,"PAGE: "_PSNCFPG,!,PSNCFLIN S PSNCFPG=PSNCFPG+1
 Q
 ;
CHOOSE ;File Selection
 K DIR,X,Y,DIRUT,DUOUT S PSNCFQ=0 S DIR(0)="LA^1:"_CNT
 S DIR("A")="Select "_$S(PSNCFAX="D":"a Download",1:"an Install")_" File for greater detail. Choose 1-"_CNT_" or '^' to Quit: "
 S DIR("?")="Select from the above list of files or a enter '^' to Quit."
 D ^DIR I $D(DIRUT)!($D(DUOUT)) S PSNCFQ=1 Q
 S PSNCFANS=$P(Y,",",1),PSNCFIEN=$P(PSNCFSM(PSNCFANS),"^",1)
 Q
 ;
INSTALL ; INSTALL SCREEN
 K PSNCFARR
 D GETS^DIQ(57.231,PSNCFIEN_",1,","**","ERN","PSNCFARR")  ;INSTALL INFORMATION
 W !!,"Current Install Status:",!,"-----------------------"
 W !,"Name: ",?30,$G(PSNCFAR(57.23,"1,",.01,"E"))
 W !,"Open VMS Local Directory:",?30,$G(PSNCFAR(57.23,"1,",1,"E"))
 W !,"UNIX/LINUX Local Directory:",?30,$G(PSNCFAR(57.23,"1,",3,"E"))
 W !,"PPS-N Install Version:",?30,$G(PSNCFAR(57.23,"1,",2,"E"))
 W !,"PPS-N Mail Group:",?30,$G(PSNCFAR(57.23,"1,",5,"E"))
 W !,"Secondary Mail Group:",?30,$G(PSNCFAR(57.23,"1,",6,"E"))
 W !,"PPS-N Download Version:",?30,$G(PSNCFAR(57.23,"1,",8,"E"))
 W !,"Download Status:",?30,$G(PSNCFAR(57.23,"1,",9,"E"))
 W !,"Install Status:",?30,$G(PSNCFAR(57.23,"1,",10,"E"))
 W !!,"Install Information for file "_PSNINNM_":",!,"--------------------------------------------------"
 W !,"Install Begin Date/Time:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","INSTALL BEGIN DATE/TIME","E"))
 W !,"Install Completion Date/Time:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","INSTALL COMPLETION DATE/TIME","E"))
 W !,"Last VistA file processed:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST VISTA FILE PROCESSED","E"))
 W !,"Last File IEN processed:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST FILE IEN PROCESSED","E"))
 W !,"Last TMP file subscript:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST TMP FILE SUBSCRIPT","E"))
 W !,"Last Update file section:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST UPDATE FILE SECTION","E"))
 W !,"Displayed Last:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","DISPLAYED LAST","E"))
 ; ask if Error or Quit
 W ! K DIR,Y S DIR(0)="SA^E:ERROR;Q:QUIT"
 S DIR("A")="Select (E)rror Detail or (Q)uit: "
 D ^DIR I Y="Q"!$D(DIRUT) S PSNCFQ=1 Q
 S PSNCFXX=Y
 I PSNCFXX="E" D ERROR G INSTALL
 Q
DOWNLD ; DOWNLOAD HISTORY
 S PSNCFPG=1,PSFLG=0 D HEAD1("DOWNLOAD")
 S PSNJ="" F  S PSNJ=$O(^PS(57.23,1,4,"B",$P(PSNINNM,";",1),PSNJ)) Q:PSNJ=""   D  I PSFLG=1 D CONT Q
 . S PSNDND=$G(^PS(57.23,1,4,PSNJ,0)) I PSNDND="" W !!,"No Download Information for this file" S PSFLG=1 Q
 . W !,"Download File Name:",?33,$P(PSNDND,"^",1)
 . W !,"Download Begin Date/Time:",?33,$$FMTE^XLFDT($P(PSNDND,"^",2))
 . W !,"Download Complete Date/Time:",?33,$$FMTE^XLFDT($P(PSNDND,"^",3))
 . W !,"Download File Size:",?33,$E($P(PSNDND,"^",4),2,99)
 . W !,"Download Error Message:" I $L($P(PSNDND,"^",5))<46 W ?33,$P(PSNDND,"^",5),! Q
 . N X,DIWL,DIWR,DIWF S X=$P(PSNDND,"^",5),DIWL=34,DIWR=79,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
 Q
 ;
ERROR ; INSTALL ERROR SCREEN
 S PSNCFPG=1 D HEAD1("ERROR")
 I '$D(^PS(57.23,1,5,PSNCFIEN,2,1,0)) W !!,"No Error Information for this file" D CONT Q
 S PSNJ="" F PSNJ=1:1 S PSNJ=$O(^PS(57.23,1,5,PSNCFIEN,2,PSNJ)) Q:PSNJ=""  D
 . S PSNJD=$G(^PS(57.23,1,5,PSNCFIEN,2,PSNJ,0))
 . W !,"Error Date/Time:",?33,$$FMTE^XLFDT($P(PSNJD,"^",1))
 . W !,"Error File:",?33,$P(PSNJD,"^",2)
 . W !,"Error IEN:",?33,$P(PSNJD,"^",3)
 . W !,"Error TMP file subscript:",?33,$P(PSNJD,"^",4)
 . W !,"Error Message: " I $L($P(PSNJD,"^",5))<46 W ?33,$P(PSNJD,"^",5),! Q
 . N X,DIWL,DIWR,DIWF S X=$P(PSNJD,"^",5),DIWL=33,DIWR=79,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
 D CONT
 Q
 ;
CONT ;
 K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR
 Q
 ;
END ; KILL VARIABLES
 K X,%DT,DA,DA,DIC,DIE,DIR,DR,DIRUT,DTOUT,PSNCFAR,PSNCFER,PSNCFARR,PSNCFDEV,PSNINNM,PSNCARR,PSNDND
 K PSNCFBEG,PSNCFEND,PSNCFOUT,PSNCFPG,PSNCFL2,PSNCFLIN,PSNCFBG,PSNCFIEN,PSNCFXX,PSNCFDN,PSNCFANS
 K PSNCFSM,PSNDT,PSNH,PSNJ,PSNX,PSFLG,PSNJD,PSNCFAX,PSNCFQ,PSNJ,PSNCFE,PSNCFB
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNCFINQ   7620     printed  Sep 23, 2025@19:59:44                                                                                                                                                                                                    Page 2
PSNCFINQ  ;BIR/PC - Control File Inquiry Screen ;01/30/2017
 +1       ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
 +2       ;
 +3        NEW PSNCFBEG,PSNCFEND,PSNCFB,PSNCFE,PSNCFIEN,CNT,PSNCFAX
 +4        KILL DIC,DIR
ASK       ;ask if Download or Install Inquiry
 +1        SET (PSNCFOUT,PSNCFQ)=0
           SET PSNCFPG=1
           SET $PIECE(PSNCFLIN,"-",78)=""
 +2        WRITE !
           KILL DIR,Y
           SET DIR(0)="SA^D:DOWNLOAD;I:INSTALL;Q:QUIT"
 +3        SET DIR("A")="Select (D)ownload Detail, (I)nstall Detail or (Q)uit: "
 +4        DO ^DIR
           IF Y="Q"!$DATA(DIRUT)
               GOTO END
 +5        SET PSNCFAX=Y
 +6        DO DATE
           IF PSNCFQ=1
               GOTO END
ASK1      ;
 +1        DO @$SELECT(PSNCFAX="I":"ISUM",1:"DSUM")
           IF PSNCFQ=1
               GOTO ASK
 +2        DO CHOOSE
           IF PSNCFQ=1!($DATA(DIRUT))
               GOTO ASK
 +3       ;ZERO level
           KILL PSNCFAR
           DO GETS^DIQ(57.23,1,".01;1;2;3;5;6;8;9;10","E","PSNCFAR")
 +4        SET PSNINNM=$SELECT(PSNCFAX="I":$$GET1^DIQ(57.231,PSNCFIEN_",1,",.01,"E"),1:$$GET1^DIQ(57.234,PSNCFIEN_",1,",.01,"E"))
 +5        IF PSNCFAX="I"
               DO INSTALL
               SET PSNCFQ=0
               GOTO ASK1
 +6        IF PSNCFAX="D"
               DO DOWNLD
               DO CONT
               GOTO ASK1
 +7        QUIT 
DATE      ;enter date range for list of .DAT files
 +1        NEW %DT,X
           KILL PSNDT
 +2        SET %DT(0)=-DT
           SET %DT="AEP"
           SET %DT("A")="Enter Start Date: "
           WRITE !
           DO ^%DT
           IF Y<0!($DATA(DTOUT))
               SET PSNCFQ=1
               QUIT 
 +3        SET PSNCFBEG=Y\1-.00001
           SET PSNCFB=Y
 +4        SET %DT(0)=PSNCFBEG+1\1
           SET %DT("A")="Enter End Date: "
           WRITE !
           DO ^%DT
           IF Y<0!($DATA(DTOUT))
               SET PSNCFQ=1
               QUIT 
 +5        SET PSNCFEND=Y\1+.99999
           SET PSNCFE=Y
 +6        SET PSNCFL2=$$FMTE^XLFDT(PSNCFB)_" to "_$$FMTE^XLFDT(PSNCFE)
 +7        SET PSNCFOUT=0
           SET PSNCFDEV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
           SET PSNCFPG=1
 +8        QUIT 
 +9       ;
ISUM      ; SUMMARY SCREEN FOR INSTALL FILES
 +1        KILL PSNX1,PSNCARR
           SET PSNCFPG=1
           SET PSNJ=""
 +2        DO HEAD
           SET CNT=0
           SET PSNCFOUT=0
 +3        IF '$DATA(PSNDT)
               SET PSNX1=PSNCFBEG
               FOR 
                   SET PSNX1=$ORDER(^PS(57.23,1,5,"C",PSNX1))
                   if PSNX1=""!(PSNX1>PSNCFEND)
                       QUIT 
                   FOR 
                       SET PSNJ=$ORDER(^PS(57.23,1,5,"C",PSNX1,PSNJ))
                       if PSNJ=""
                           QUIT 
                       SET PSNDT(PSNJ)=PSNX1
 +4        SET PSNCFIEN=0
           FOR 
               SET PSNCFIEN=$ORDER(PSNDT(PSNCFIEN))
               if PSNCFIEN=""
                   QUIT 
               DO GETS^DIQ(57.231,PSNCFIEN_",1",".01;1;2","E","PSNCARR")
               Begin DoDot:1
 +5                SET CNT=CNT+1
                   SET PSNCFSM(CNT)=PSNCFIEN_"^"_PSNCARR(57.231,PSNCFIEN_",1,",.01,"E")
 +6                WRITE !,"("_CNT_") ",PSNCARR(57.231,PSNCFIEN_",1,",.01,"E"),?32,PSNCARR(57.231,PSNCFIEN_",1,",1,"E"),?55,PSNCARR(57.231,PSNCFIEN_",1,",2,"E")
 +7                IF ($Y+5)>IOSL
                       DO HEAD
                       if PSNCFOUT=1
                           QUIT 
               End DoDot:1
               if PSNCFOUT=1
                   QUIT 
 +8        WRITE !!
           IF CNT=0
               WRITE !!,"No Install files for date range chosen.  Please enter new dates.",$CHAR(7)
               WRITE !
               DO CONT
               SET PSNCFQ=1
 +9        QUIT 
 +10      ;
DSUM      ; SUMMARY SCREEN FOR DOWNLOAD FILES
 +1        KILL PSNX1,PSNCARD
           SET PSNCFPG=1
           SET PSNJ=""
 +2        DO HEAD
           SET CNT=0
           SET PSNCFOUT=0
 +3        IF '$DATA(PSNDT)
               SET PSNX1=PSNCFBEG
               FOR 
                   SET PSNX1=$ORDER(^PS(57.23,1,4,"D",PSNX1))
                   if PSNX1=""!(PSNX1>PSNCFEND)
                       QUIT 
                   FOR 
                       SET PSNJ=$ORDER(^PS(57.23,1,4,"D",PSNX1,PSNJ))
                       if PSNJ=""
                           QUIT 
                       SET PSNDT(PSNJ)=PSNX1
 +4        SET PSNCFIEN=0
           FOR 
               SET PSNCFIEN=$ORDER(PSNDT(PSNCFIEN))
               if PSNCFIEN=""
                   QUIT 
               DO GETS^DIQ(57.234,PSNCFIEN_",1",".01;1;2","E","PSNCARD")
               Begin DoDot:1
 +5                SET CNT=CNT+1
                   SET PSNCFSM(CNT)=PSNCFIEN_"^"_PSNCARD(57.234,PSNCFIEN_",1,",.01,"E")
 +6                WRITE !,"("_CNT_") ",PSNCARD(57.234,PSNCFIEN_",1,",.01,"E"),?32,PSNCARD(57.234,PSNCFIEN_",1,",1,"E"),?55,PSNCARD(57.234,PSNCFIEN_",1,",2,"E")
 +7                IF ($Y+5)>IOSL
                       DO HEAD
                       if PSNCFOUT=1
                           QUIT 
               End DoDot:1
               if PSNCFOUT=1
                   QUIT 
 +8        WRITE !!
           IF CNT=0
               WRITE !!,"No Download files for date range chosen.  Please enter new dates.",$CHAR(7)
               WRITE !
               DO CONT
               SET PSNCFQ=1
 +9        QUIT 
 +10      ;
HEAD      ; SUMMARY HEADER PAGE
 +1        IF $GET(PSNCFPG)'=1
               WRITE !
               KILL DIR,Y
               SET DIR(0)="E"
               SET DIR("A")="Press Return to continue, '^' to exit"
               DO ^DIR
               KILL DIR
               IF 'Y
                   SET PSNCFOUT=1
                   QUIT 
 +2        WRITE @IOF
 +3        WRITE !,$SELECT(PSNCFAX="D":"DOWNLOAD",1:"INSTALL")_" FILE NAME",?32,$SELECT(PSNCFAX="D":"DOWNLOAD",1:"INSTALL")_" BEGIN DT/TM",?55,"COMPLETION DT/TM"
 +4        WRITE !,PSNCFL2,?68,"PAGE: "_PSNCFPG,!,PSNCFLIN
           SET PSNCFPG=PSNCFPG+1
 +5        QUIT 
 +6       ;
HEAD1(PSNH) ; DETAIL HEADER PAGE
 +1       ;PSNP = DETAIL OR ERROR
 +2        IF $GET(PSNCFPG)'=1
               WRITE !
               KILL DIR,Y
               SET DIR(0)="E"
               SET DIR("A")="Press Return to continue, '^' to exit"
               DO ^DIR
               KILL DIR
               IF 'Y
                   SET PSNCFQ=1
                   QUIT 
 +3        WRITE @IOF
 +4        WRITE !,PSNH_" INFORMATION FOR FILE "_PSNINNM
 +5        WRITE !,?68,"PAGE: "_PSNCFPG,!,PSNCFLIN
           SET PSNCFPG=PSNCFPG+1
 +6        QUIT 
 +7       ;
CHOOSE    ;File Selection
 +1        KILL DIR,X,Y,DIRUT,DUOUT
           SET PSNCFQ=0
           SET DIR(0)="LA^1:"_CNT
 +2        SET DIR("A")="Select "_$SELECT(PSNCFAX="D":"a Download",1:"an Install")_" File for greater detail. Choose 1-"_CNT_" or '^' to Quit: "
 +3        SET DIR("?")="Select from the above list of files or a enter '^' to Quit."
 +4        DO ^DIR
           IF $DATA(DIRUT)!($DATA(DUOUT))
               SET PSNCFQ=1
               QUIT 
 +5        SET PSNCFANS=$PIECE(Y,",",1)
           SET PSNCFIEN=$PIECE(PSNCFSM(PSNCFANS),"^",1)
 +6        QUIT 
 +7       ;
INSTALL   ; INSTALL SCREEN
 +1        KILL PSNCFARR
 +2       ;INSTALL INFORMATION
           DO GETS^DIQ(57.231,PSNCFIEN_",1,","**","ERN","PSNCFARR")
 +3        WRITE !!,"Current Install Status:",!,"-----------------------"
 +4        WRITE !,"Name: ",?30,$GET(PSNCFAR(57.23,"1,",.01,"E"))
 +5        WRITE !,"Open VMS Local Directory:",?30,$GET(PSNCFAR(57.23,"1,",1,"E"))
 +6        WRITE !,"UNIX/LINUX Local Directory:",?30,$GET(PSNCFAR(57.23,"1,",3,"E"))
 +7        WRITE !,"PPS-N Install Version:",?30,$GET(PSNCFAR(57.23,"1,",2,"E"))
 +8        WRITE !,"PPS-N Mail Group:",?30,$GET(PSNCFAR(57.23,"1,",5,"E"))
 +9        WRITE !,"Secondary Mail Group:",?30,$GET(PSNCFAR(57.23,"1,",6,"E"))
 +10       WRITE !,"PPS-N Download Version:",?30,$GET(PSNCFAR(57.23,"1,",8,"E"))
 +11       WRITE !,"Download Status:",?30,$GET(PSNCFAR(57.23,"1,",9,"E"))
 +12       WRITE !,"Install Status:",?30,$GET(PSNCFAR(57.23,"1,",10,"E"))
 +13       WRITE !!,"Install Information for file "_PSNINNM_":",!,"--------------------------------------------------"
 +14       WRITE !,"Install Begin Date/Time:",?30,$GET(PSNCFARR(57.231,PSNCFIEN_",1,","INSTALL BEGIN DATE/TIME","E"))
 +15       WRITE !,"Install Completion Date/Time:",?30,$GET(PSNCFARR(57.231,PSNCFIEN_",1,","INSTALL COMPLETION DATE/TIME","E"))
 +16       WRITE !,"Last VistA file processed:",?30,$GET(PSNCFARR(57.231,PSNCFIEN_",1,","LAST VISTA FILE PROCESSED","E"))
 +17       WRITE !,"Last File IEN processed:",?30,$GET(PSNCFARR(57.231,PSNCFIEN_",1,","LAST FILE IEN PROCESSED","E"))
 +18       WRITE !,"Last TMP file subscript:",?30,$GET(PSNCFARR(57.231,PSNCFIEN_",1,","LAST TMP FILE SUBSCRIPT","E"))
 +19       WRITE !,"Last Update file section:",?30,$GET(PSNCFARR(57.231,PSNCFIEN_",1,","LAST UPDATE FILE SECTION","E"))
 +20       WRITE !,"Displayed Last:",?30,$GET(PSNCFARR(57.231,PSNCFIEN_",1,","DISPLAYED LAST","E"))
 +21      ; ask if Error or Quit
 +22       WRITE !
           KILL DIR,Y
           SET DIR(0)="SA^E:ERROR;Q:QUIT"
 +23       SET DIR("A")="Select (E)rror Detail or (Q)uit: "
 +24       DO ^DIR
           IF Y="Q"!$DATA(DIRUT)
               SET PSNCFQ=1
               QUIT 
 +25       SET PSNCFXX=Y
 +26       IF PSNCFXX="E"
               DO ERROR
               GOTO INSTALL
 +27       QUIT 
DOWNLD    ; DOWNLOAD HISTORY
 +1        SET PSNCFPG=1
           SET PSFLG=0
           DO HEAD1("DOWNLOAD")
 +2        SET PSNJ=""
           FOR 
               SET PSNJ=$ORDER(^PS(57.23,1,4,"B",$PIECE(PSNINNM,";",1),PSNJ))
               if PSNJ=""
                   QUIT 
               Begin DoDot:1
 +3                SET PSNDND=$GET(^PS(57.23,1,4,PSNJ,0))
                   IF PSNDND=""
                       WRITE !!,"No Download Information for this file"
                       SET PSFLG=1
                       QUIT 
 +4                WRITE !,"Download File Name:",?33,$PIECE(PSNDND,"^",1)
 +5                WRITE !,"Download Begin Date/Time:",?33,$$FMTE^XLFDT($PIECE(PSNDND,"^",2))
 +6                WRITE !,"Download Complete Date/Time:",?33,$$FMTE^XLFDT($PIECE(PSNDND,"^",3))
 +7                WRITE !,"Download File Size:",?33,$EXTRACT($PIECE(PSNDND,"^",4),2,99)
 +8                WRITE !,"Download Error Message:"
                   IF $LENGTH($PIECE(PSNDND,"^",5))<46
                       WRITE ?33,$PIECE(PSNDND,"^",5),!
                       QUIT 
 +9                NEW X,DIWL,DIWR,DIWF
                   SET X=$PIECE(PSNDND,"^",5)
                   SET DIWL=34
                   SET DIWR=79
                   SET DIWF="W"
                   KILL ^UTILITY($JOB,"W")
                   DO ^DIWP
                   DO ^DIWW
                   KILL ^UTILITY($JOB,"W")
               End DoDot:1
               IF PSFLG=1
                   DO CONT
                   QUIT 
 +10       QUIT 
 +11      ;
ERROR     ; INSTALL ERROR SCREEN
 +1        SET PSNCFPG=1
           DO HEAD1("ERROR")
 +2        IF '$DATA(^PS(57.23,1,5,PSNCFIEN,2,1,0))
               WRITE !!,"No Error Information for this file"
               DO CONT
               QUIT 
 +3        SET PSNJ=""
           FOR PSNJ=1:1
               SET PSNJ=$ORDER(^PS(57.23,1,5,PSNCFIEN,2,PSNJ))
               if PSNJ=""
                   QUIT 
               Begin DoDot:1
 +4                SET PSNJD=$GET(^PS(57.23,1,5,PSNCFIEN,2,PSNJ,0))
 +5                WRITE !,"Error Date/Time:",?33,$$FMTE^XLFDT($PIECE(PSNJD,"^",1))
 +6                WRITE !,"Error File:",?33,$PIECE(PSNJD,"^",2)
 +7                WRITE !,"Error IEN:",?33,$PIECE(PSNJD,"^",3)
 +8                WRITE !,"Error TMP file subscript:",?33,$PIECE(PSNJD,"^",4)
 +9                WRITE !,"Error Message: "
                   IF $LENGTH($PIECE(PSNJD,"^",5))<46
                       WRITE ?33,$PIECE(PSNJD,"^",5),!
                       QUIT 
 +10               NEW X,DIWL,DIWR,DIWF
                   SET X=$PIECE(PSNJD,"^",5)
                   SET DIWL=33
                   SET DIWR=79
                   SET DIWF="W"
                   KILL ^UTILITY($JOB,"W")
                   DO ^DIWP
                   DO ^DIWW
                   KILL ^UTILITY($JOB,"W")
               End DoDot:1
 +11       DO CONT
 +12       QUIT 
 +13      ;
CONT      ;
 +1        KILL DIR
           SET DIR(0)="E"
           SET DIR("A")="Press Return to Continue"
           DO ^DIR
 +2        QUIT 
 +3       ;
END       ; KILL VARIABLES
 +1        KILL X,%DT,DA,DA,DIC,DIE,DIR,DR,DIRUT,DTOUT,PSNCFAR,PSNCFER,PSNCFARR,PSNCFDEV,PSNINNM,PSNCARR,PSNDND
 +2        KILL PSNCFBEG,PSNCFEND,PSNCFOUT,PSNCFPG,PSNCFL2,PSNCFLIN,PSNCFBG,PSNCFIEN,PSNCFXX,PSNCFDN,PSNCFANS
 +3        KILL PSNCFSM,PSNDT,PSNH,PSNJ,PSNX,PSFLG,PSNJD,PSNCFAX,PSNCFQ,PSNJ,PSNCFE,PSNCFB
 +4        QUIT