Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSNCFINQ

PSNCFINQ.m

Go to the documentation of this file.
  1. PSNCFINQ ;BIR/PC - Control File Inquiry Screen ;01/30/2017
  1. ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
  1. ;
  1. N PSNCFBEG,PSNCFEND,PSNCFB,PSNCFE,PSNCFIEN,CNT,PSNCFAX
  1. K DIC,DIR
  1. ASK ;ask if Download or Install Inquiry
  1. S (PSNCFOUT,PSNCFQ)=0,PSNCFPG=1,$P(PSNCFLIN,"-",78)=""
  1. W ! K DIR,Y S DIR(0)="SA^D:DOWNLOAD;I:INSTALL;Q:QUIT"
  1. S DIR("A")="Select (D)ownload Detail, (I)nstall Detail or (Q)uit: "
  1. D ^DIR I Y="Q"!$D(DIRUT) G END
  1. S PSNCFAX=Y
  1. D DATE I PSNCFQ=1 G END
  1. ASK1 ;
  1. D @$S(PSNCFAX="I":"ISUM",1:"DSUM") I PSNCFQ=1 G ASK
  1. D CHOOSE I PSNCFQ=1!($D(DIRUT)) G ASK
  1. K PSNCFAR D GETS^DIQ(57.23,1,".01;1;2;3;5;6;8;9;10","E","PSNCFAR") ;ZERO level
  1. S PSNINNM=$S(PSNCFAX="I":$$GET1^DIQ(57.231,PSNCFIEN_",1,",.01,"E"),1:$$GET1^DIQ(57.234,PSNCFIEN_",1,",.01,"E"))
  1. I PSNCFAX="I" D INSTALL S PSNCFQ=0 G ASK1
  1. I PSNCFAX="D" D DOWNLD,CONT G ASK1
  1. Q
  1. DATE ;enter date range for list of .DAT files
  1. N %DT,X K PSNDT
  1. S %DT(0)=-DT,%DT="AEP",%DT("A")="Enter Start Date: " W ! D ^%DT I Y<0!($D(DTOUT)) S PSNCFQ=1 Q
  1. S PSNCFBEG=Y\1-.00001,PSNCFB=Y
  1. S %DT(0)=PSNCFBEG+1\1,%DT("A")="Enter End Date: " W ! D ^%DT I Y<0!($D(DTOUT)) S PSNCFQ=1 Q
  1. S PSNCFEND=Y\1+.99999,PSNCFE=Y
  1. S PSNCFL2=$$FMTE^XLFDT(PSNCFB)_" to "_$$FMTE^XLFDT(PSNCFE)
  1. S PSNCFOUT=0,PSNCFDEV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSNCFPG=1
  1. Q
  1. ;
  1. ISUM ; SUMMARY SCREEN FOR INSTALL FILES
  1. K PSNX1,PSNCARR S PSNCFPG=1,PSNJ=""
  1. D HEAD S CNT=0,PSNCFOUT=0
  1. 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
  1. 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
  1. . S CNT=CNT+1,PSNCFSM(CNT)=PSNCFIEN_"^"_PSNCARR(57.231,PSNCFIEN_",1,",.01,"E")
  1. . 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")
  1. . I ($Y+5)>IOSL D HEAD Q:PSNCFOUT=1
  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
  1. Q
  1. ;
  1. DSUM ; SUMMARY SCREEN FOR DOWNLOAD FILES
  1. K PSNX1,PSNCARD S PSNCFPG=1,PSNJ=""
  1. D HEAD S CNT=0,PSNCFOUT=0
  1. 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
  1. 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
  1. . S CNT=CNT+1,PSNCFSM(CNT)=PSNCFIEN_"^"_PSNCARD(57.234,PSNCFIEN_",1,",.01,"E")
  1. . 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")
  1. . I ($Y+5)>IOSL D HEAD Q:PSNCFOUT=1
  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
  1. Q
  1. ;
  1. 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
  1. W @IOF
  1. W !,$S(PSNCFAX="D":"DOWNLOAD",1:"INSTALL")_" FILE NAME",?32,$S(PSNCFAX="D":"DOWNLOAD",1:"INSTALL")_" BEGIN DT/TM",?55,"COMPLETION DT/TM"
  1. W !,PSNCFL2,?68,"PAGE: "_PSNCFPG,!,PSNCFLIN S PSNCFPG=PSNCFPG+1
  1. Q
  1. ;
  1. HEAD1(PSNH) ; DETAIL HEADER PAGE
  1. ;PSNP = DETAIL OR ERROR
  1. 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
  1. W @IOF
  1. W !,PSNH_" INFORMATION FOR FILE "_PSNINNM
  1. W !,?68,"PAGE: "_PSNCFPG,!,PSNCFLIN S PSNCFPG=PSNCFPG+1
  1. Q
  1. ;
  1. CHOOSE ;File Selection
  1. K DIR,X,Y,DIRUT,DUOUT S PSNCFQ=0 S DIR(0)="LA^1:"_CNT
  1. S DIR("A")="Select "_$S(PSNCFAX="D":"a Download",1:"an Install")_" File for greater detail. Choose 1-"_CNT_" or '^' to Quit: "
  1. S DIR("?")="Select from the above list of files or a enter '^' to Quit."
  1. D ^DIR I $D(DIRUT)!($D(DUOUT)) S PSNCFQ=1 Q
  1. S PSNCFANS=$P(Y,",",1),PSNCFIEN=$P(PSNCFSM(PSNCFANS),"^",1)
  1. Q
  1. ;
  1. INSTALL ; INSTALL SCREEN
  1. K PSNCFARR
  1. D GETS^DIQ(57.231,PSNCFIEN_",1,","**","ERN","PSNCFARR") ;INSTALL INFORMATION
  1. W !!,"Current Install Status:",!,"-----------------------"
  1. W !,"Name: ",?30,$G(PSNCFAR(57.23,"1,",.01,"E"))
  1. W !,"Open VMS Local Directory:",?30,$G(PSNCFAR(57.23,"1,",1,"E"))
  1. W !,"UNIX/LINUX Local Directory:",?30,$G(PSNCFAR(57.23,"1,",3,"E"))
  1. W !,"PPS-N Install Version:",?30,$G(PSNCFAR(57.23,"1,",2,"E"))
  1. W !,"PPS-N Mail Group:",?30,$G(PSNCFAR(57.23,"1,",5,"E"))
  1. W !,"Secondary Mail Group:",?30,$G(PSNCFAR(57.23,"1,",6,"E"))
  1. W !,"PPS-N Download Version:",?30,$G(PSNCFAR(57.23,"1,",8,"E"))
  1. W !,"Download Status:",?30,$G(PSNCFAR(57.23,"1,",9,"E"))
  1. W !,"Install Status:",?30,$G(PSNCFAR(57.23,"1,",10,"E"))
  1. W !!,"Install Information for file "_PSNINNM_":",!,"--------------------------------------------------"
  1. W !,"Install Begin Date/Time:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","INSTALL BEGIN DATE/TIME","E"))
  1. W !,"Install Completion Date/Time:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","INSTALL COMPLETION DATE/TIME","E"))
  1. W !,"Last VistA file processed:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST VISTA FILE PROCESSED","E"))
  1. W !,"Last File IEN processed:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST FILE IEN PROCESSED","E"))
  1. W !,"Last TMP file subscript:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST TMP FILE SUBSCRIPT","E"))
  1. W !,"Last Update file section:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","LAST UPDATE FILE SECTION","E"))
  1. W !,"Displayed Last:",?30,$G(PSNCFARR(57.231,PSNCFIEN_",1,","DISPLAYED LAST","E"))
  1. ; ask if Error or Quit
  1. W ! K DIR,Y S DIR(0)="SA^E:ERROR;Q:QUIT"
  1. S DIR("A")="Select (E)rror Detail or (Q)uit: "
  1. D ^DIR I Y="Q"!$D(DIRUT) S PSNCFQ=1 Q
  1. S PSNCFXX=Y
  1. I PSNCFXX="E" D ERROR G INSTALL
  1. Q
  1. DOWNLD ; DOWNLOAD HISTORY
  1. S PSNCFPG=1,PSFLG=0 D HEAD1("DOWNLOAD")
  1. 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
  1. . S PSNDND=$G(^PS(57.23,1,4,PSNJ,0)) I PSNDND="" W !!,"No Download Information for this file" S PSFLG=1 Q
  1. . W !,"Download File Name:",?33,$P(PSNDND,"^",1)
  1. . W !,"Download Begin Date/Time:",?33,$$FMTE^XLFDT($P(PSNDND,"^",2))
  1. . W !,"Download Complete Date/Time:",?33,$$FMTE^XLFDT($P(PSNDND,"^",3))
  1. . W !,"Download File Size:",?33,$E($P(PSNDND,"^",4),2,99)
  1. . W !,"Download Error Message:" I $L($P(PSNDND,"^",5))<46 W ?33,$P(PSNDND,"^",5),! Q
  1. . 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")
  1. Q
  1. ;
  1. ERROR ; INSTALL ERROR SCREEN
  1. S PSNCFPG=1 D HEAD1("ERROR")
  1. I '$D(^PS(57.23,1,5,PSNCFIEN,2,1,0)) W !!,"No Error Information for this file" D CONT Q
  1. S PSNJ="" F PSNJ=1:1 S PSNJ=$O(^PS(57.23,1,5,PSNCFIEN,2,PSNJ)) Q:PSNJ="" D
  1. . S PSNJD=$G(^PS(57.23,1,5,PSNCFIEN,2,PSNJ,0))
  1. . W !,"Error Date/Time:",?33,$$FMTE^XLFDT($P(PSNJD,"^",1))
  1. . W !,"Error File:",?33,$P(PSNJD,"^",2)
  1. . W !,"Error IEN:",?33,$P(PSNJD,"^",3)
  1. . W !,"Error TMP file subscript:",?33,$P(PSNJD,"^",4)
  1. . W !,"Error Message: " I $L($P(PSNJD,"^",5))<46 W ?33,$P(PSNJD,"^",5),! Q
  1. . 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")
  1. D CONT
  1. Q
  1. ;
  1. CONT ;
  1. K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR
  1. Q
  1. ;
  1. END ; KILL VARIABLES
  1. K X,%DT,DA,DA,DIC,DIE,DIR,DR,DIRUT,DTOUT,PSNCFAR,PSNCFER,PSNCFARR,PSNCFDEV,PSNINNM,PSNCARR,PSNDND
  1. K PSNCFBEG,PSNCFEND,PSNCFOUT,PSNCFPG,PSNCFL2,PSNCFLIN,PSNCFBG,PSNCFIEN,PSNCFXX,PSNCFDN,PSNCFANS
  1. K PSNCFSM,PSNDT,PSNH,PSNJ,PSNX,PSFLG,PSNJD,PSNCFAX,PSNCFQ,PSNJ,PSNCFE,PSNCFB
  1. Q