- PSNPPSNV ;HP/MJE-PPSN update NDF data additional update code ; 05 Mar 2014 1:20 PM
- ;;4.0;NATIONAL DRUG FILE;**513,563,565**; 30 Oct 98;Build 16
- ;Reference to ^PS(59.7 supported by DBIA #2613
- ;
- Q
- DATA ;Process DATA transactions
- K FDA
- S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="DATA"
- D UPDATE^DIE("","FDA","CTRLIEN")
- K FDA
- I '$D(^TMP("PSN PPSN PARSED",$J,"DATA")) Q
- N DA,I,J,K,LINE,PSN,ROOT,X
- S ROOT=$NA(^TMP("PSN PPSN PARSED",$J,"DATA")),J=0
- F S J=$O(@ROOT@(J)) Q:'J S LINE=^(J),K=$L(LINE,"|")-1 F I=1:1:K S X=$P(LINE,"|",I),^TMP($J,$P(X,"^"))=$P(X,"^",2,4)
- ; Updating GCNSEQNO, PREVIOUS GCNSEQNO and NDC LINK TO GCNSEQNO fields
- S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA D
- . I $D(^TMP($J,DA)) S $P(^PSNDF(50.68,DA,1),"^",5,7)=$P(^TMP($J,DA),"^",1,3)
- K ^TMP($J)
- K DA,I,J,K,LINE,PSN,ROOT,X
- Q
- ;
- PMIUPDT ;Get PMI data and completly replace all globals 50.621-627
- N FDA,DA,I,J,K,LINE,PSN,ROOT,X
- S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="PMIDATA"
- D UPDATE^DIE("","FDA","CTRLIEN")
- N FDA,DA,I,J,K,LINE,PSN,X
- I $D(^TMP("PSN PPSN PARSED",$J,"PMIDATA")) F PSN=50.621:.001:50.627 K ^PS(PSN)
- S ROOT=$NA(^TMP("PSN PPSN PARSED",$J,"DATA")),J=0
- K ^TMP($J)
- F S J=$O(@ROOT@(J)) Q:'J S LINE=^(J),K=$L(LINE,"|")-1 F I=1:1:K S X=$P(LINE,"|",I),^TMP($J,$P(X,"^"))=$P(X,"^",2,4)
- ; Updating GCNSEQNO, PREVIOUS GCNSEQNO and NDC LINK TO GCNSEQNO fields
- S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA D
- . I $D(^TMP($J,DA)) S $P(^PSNDF(50.68,DA,1),"^",5,7)=$P(^TMP($J,DA),"^",1,3)
- K ^TMP($J)
- I $D(^TMP("PSN PPSN PARSED",$J,"PMIDATA")) F PSN=50.621:.001:50.627 M ^PS(PSN)=^TMP("PSN PPSN PARSED",$J,"PMIDATA",PSN)
- K DA,I,J,K,LINE,PSN,ROOT,X
- Q
- ;
- TASKIT(FREQ,START) ; create/update PSNTUPDT option start time and frequency
- ; Input:
- ; FREQ - Optional
- ; START - Optional
- ;
- K PSERROR
- D NOW^%DTC S %DT(0)=%,%DT="EFATX",%DT("A")="Enter date/time: " D ^%DT
- I (Y<0)!($D(DTOUT)) W !!,"No action taken!" D ENTER W @IOF Q
- S START=$$FMADD^XLFDT(Y,0,0,5)
- ;
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Should this NDF update install be re-scheduled at the same time weekly" W !!
- S DIR("B")="NO" D ^DIR I Y S FREQ="7D" G END
- I $D(DIRUT) W !!,"No action taken!" D ENTER W @IOF Q
- ;
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Should this NDF update install be re-scheduled at the same time daily" W !!
- S DIR("B")="NO" D ^DIR I Y S FREQ="1D" G END
- I $D(DIRUT) W !!,"No action taken!" D ENTER W @IOF Q
- I 'Y S FREQ="" W !!,"Warning! The download you have scheduled will occur only once."
- ;
- END ;
- I FREQ="" D RESCH^XUTMOPT("PSN TASK SCHEDULED INSTALL","@","","@")
- W !,"Your start time is:"
- D RESCH^XUTMOPT("PSN TASK SCHEDULED INSTALL",START,"",FREQ,"L",.PSERROR)
- I +FREQ=1 W !!,"The NDF update install will automatically be re-scheduled Daily",!
- I +FREQ=7 W !!,"The NDF update install will automatically be re-scheduled Weekly",!
- I FREQ="" W !!,"The NDF update install will NOT automatically be re-scheduled",!
- D ENTER W @IOF
- Q
- ;
- SCHDOPT ; edit option PSNTUPDT/PSN TASK SCHEDULE INSTALL to create and/or edit the scheduling date/time
- ; Called from "PSN PPS SCHEDULE INSTALL" option to create and/or edit the scheduling
- N PSNLEGF
- I '$D(^XUSEC("PSN PPS ADMIN",DUZ)) D
- .W !!,"You do not have the appropriate security key to use this option"
- .W !,"please contact your ADPAC to resolve this issue.",!
- .S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- I '$D(^XUSEC("PSN PPS ADMIN",DUZ)) Q
- S PSNLEGF="",PSNLEGF=$$LEGACY^PSNPPSDL() I PSNLEGF Q
- W !!!,"This option allows you to schedule a recurring TaskMan job to perform the NDF"
- W !,"update installation from PPS-N."
- W !!,"Warning! This NDF update install should be scheduled during non-peak hours."
- W !!,"You will need to select a date/time and how often this update should reoccur."
- ;
- D SCHCK^PSNPPSDL("PSN TASK SCHEDULED INSTALL","I") ; print scheduled tasks
- ;
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Do you want to schedule an automatic NDF update install in TaskMan" W !!
- S DIR("B")="NO"
- D ^DIR
- I 'Y Q
- N PSSROOT
- D TASKIT(15)
- Q
- ;
- PROMPT ;
- W @IOF I '$D(^XUSEC("PSN PPS ADMIN",DUZ)) D
- .W !!,"You do not have the appropriate security key to use this option"
- .W !,"please contact your ADPAC to resolve this issue.",!
- .S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- I '$D(^XUSEC("PSN PPS ADMIN",DUZ)) Q
- W !!,"This option allows a user to setup the following PPS-N configuration settings:"
- W !!,"1) The Cache host disk directory path that will be used for location of the"
- W !," PPS-N weekly NDF update file/s."
- W !!,"2) The last successful INSTALL version number of the PPS-N update file."
- W !," This is the UPDT option version number."
- W !!,"3) The last successful DOWNLOAD version number of the PPS-N update file."
- W !," This is the DNLD option version number."
- W !!,"4) The Exchange email Group or Individual email address that the PPS-N national"
- W !," and locally generated reports will be sent to."
- W !!,"5) The PPS-N mail group for the PPSN NATIONAL TEST SQA email status."
- W !!,"6) The Scheduled Options, Menu Options, and Protocols that should be paused"
- W !," while the PPS-n update file is processed."
- W !!,"7) The PPS-N NATIONAL SQA ACCOUNT (Q)A, (P)roduction, Product (S)upport"
- W !," or (T)est."
- W !
- W ! K DIR S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- Q:Y="^"!(Y=0)
- W @IOF,!!
- W !,"At the prompt please enter the specific VMS or Linux directory path name"
- W !,"where the PPS-N update file/s will be located. If you are not familiar with"
- W !,"the required information please consult your ADPAC."
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Do you want to change the disk directory path for PPS-N Update files" W !
- S DIR("B")="NO"
- D ^DIR
- Q:Y="^"
- I Y D PATH
- ;
- UPDT ;
- W @IOF,!!!,"At the prompt you can change the last successful update version number"
- W !,"of the PPS-N update file. This is for the UPDT option."
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Do you want to change the version number of the PPS-N Update files" W !
- S DIR("B")="NO"
- D ^DIR
- Q:Y="^"
- I Y D INSTV
- K DIRUT,DUOUT,DIR,X,Y
- DNLD ;
- W @IOF,!!!,"At the prompt you can change the last successful DOWNLOAD version number"
- W !,"of the PPS-N update file. This is for the DNLD option."
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Do you want to change the DOWNLOAD version number of the PPS-N files" W !
- S DIR("B")="NO"
- D ^DIR
- Q:Y="^"
- I Y D DNLDV
- K DIRUT,DUOUT,DIR,X,Y
- DEMAIL ;
- W @IOF,!!!,"At the prompt you can change the Exchange email Group or Individual"
- W !,"email address that the PPS-N national and locally generated reports"
- W !,"will be sent to."
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Do you want to change the email address for the PPS-N update reports" W !
- S DIR("B")="NO"
- D ^DIR
- Q:Y="^"
- I Y D EMAIL
- K DIRUT,DUOUT,DIR,X,Y
- ;
- W @IOF,!!!,"At the prompt you can change the Exchange email Group or Individual"
- W !,"email address that the PPS-N PPSN NATIONAL TEST SQA emails will be sent to."
- K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Change the email address for the PPS-N PPSN NATIONAL TEST SQA emails" W !
- S DIR("B")="NO"
- D ^DIR
- Q:Y="^"
- I Y D SQAMAIL
- K DIRUT,DUOUT,DIR,X,Y
- ;
- D DISOPTS^PSNPPSNR
- K DIRUT,DUOUT,DIR,X,Y
- TYPE ;
- W @IOF,!!!,"At the prompt you can change the PPS-N NATIONAL SQA ACCOUNT"
- K DIRUT,DUOUT,DTOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
- S DIR("A")="Do you want to change the PPS-N PPSN NATIONAL TEST SQA" W !
- S DIR("B")="NO"
- D ^DIR
- Q:Y="^"!('Y)
- TYPE2 ;
- N TYPE
- S TYPE="",TYPE=$P($G(^PS(59.7,1,10)),"^",12)
- W !!,"Your current PPS-N NATIONAL SQA ACCOUNT is set to: " W TYPE_" "_$S(TYPE="Q":"for National SQA Testing",TYPE="P":"for Production",TYPE="T":"for Test Account",TYPE="S":"for Product Support",1:"")
- ;W !!,"Please enter PPS-N NATIONAL SQA ACCOUNT"
- TYPE3 ;
- W !,"P = Production",?40,"T = Test Account"
- W !,"S = Product Support",?40,"Q = QA National Testing"
- W !,"N = QA NDFMS",!
- R !,"Enter selection: ",X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1
- I X["?" D G TYPE2
- .W !!?5,"This parameter determines if the system is SQA National Testing site,"
- .W !?5,"Testing Account, Product Support or a Production site. Enter P for"
- .W !,?5,"Production, T for Test Account, S for Product Support, Q for SQA"
- .W !,?5,"National Testing or N for QA NDFMS account.",!
- .W !!?5,"Local sites should define this parameter as P for Production or T for"
- .W !?5,"their Test Account. Product support should use S. SQA National Testing"
- .W !?5,"should team should have one account defined Q for QA, a different"
- .w !?5,"account for P for Production, and another for N for QA NDFMS."
- Q:X="^"
- I ",S,Q,T,P,N,"'[(","_X_",") W !!,"You must enter P, T, S, Q or N",! G TYPE2
- I X'=""&(X'="^")&($L(X)'=0) D
- .S $P(^PS(59.7,1,10),"^",12)=X
- .W !!,"You changed the PPS-N NATIONAL SQA ACCOUNT to: " W X
- .W ! K DIR S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- K DIRUT,DUOUT,DIR,X,Y
- Q
- ;
- PATH ;
- W !!,"Your current update file path is set to: ",$$GETD^PSNFTP()
- W !!,"Please enter the complete directory path: " R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1
- I X["?" D G PATH
- .W !!?5,"Enter the operating system full directory path where the PPS-N Update",!?5,"file(s) will be stored."
- .W " Refer to the NDF Technical manual and/or",!?5,"contact your IRM for more information."
- .W !?10,"Example: ABC$:[USER.PPSN]"
- I X'=""&(X'="^")&(X'="?") D
- .D SETD(X)
- .W !!,"You changed the directory path to: " W X
- .W ! K DIR S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- Q
- ;
- INSTV ;
- W !!,"Your current PPS-N INSTALL file version number is set to: " W:$D(^PS(57.23,1,0)) $P(^PS(57.23,1,0),"^",3) W !
- W !,"Please enter the current PPS-N update file version number: " R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1
- I X["?" D G INSTV
- .W !!?5,"Enter the last file version installed on the system. If the last file"
- .W !?5,"name installed was PPS_15PRV_16NEW.DAT, the last file version would be 16."
- I X'=""&(X'="^")&($L(X)'=0)&(X'="?") D
- .S $P(^PS(57.23,1,0),"^",3)=X
- .W !!,"You changed the INSTALL file version number to: " W X
- .W ! K DIR S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- Q
- ;
- DNLDV ;
- W !!,"Your current PPS-N DOWNLOAD file version number is set to: " W:$D(^PS(57.23,1,0)) $P(^PS(57.23,1,0),"^",7) W !
- W !,"Please enter the current PPS-N DOWNLOAD file version number: " R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1
- I X["?" D G DNLDV
- .W !!?5,"Enter the last file version downloaded to the system. If the last file"
- .W !?5,"name downloaded was PPS_15PRV_16NEW.DAT, the last file version would be 16."
- I X'=""&(X'="^")&($L(X)'=0)&(X'="?") D
- .S $P(^PS(57.23,1,0),"^",7)=X
- .W !!,"You changed the DOWNLOAD file version number to: " W X
- .W ! K DIR S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- Q
- ;
- EMAIL ;
- W !!,"Your current email address is set to: " W:$D(^PS(57.23,1,0)) $P($G(^PS(57.23,1,0)),"^",6) W !
- W !,"Please enter the email address: " R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1
- I X["?" D G EMAIL
- .W !!?5,"Enter an email address for receiving PPS-N download, install and error"
- .W !?5,"messages. This is typically an MS Outlook email address since holders "
- .W !?5,"of the PSN PPS ADMIN key will continue to receive the NDF update messages."
- .W !?5,"These messages include success, completion, error, and the report"
- .W !?5,"messages like DATA UPDATE FROM NDF, etc."
- I X'=""&(X'="^")&($L(X)'=0)&(X'="?") D
- .S $P(^PS(57.23,1,0),"^",6)=X
- .W !!,"You changed the email address to: " W X
- .W ! K DIR S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- Q
- ;
- SQAMAIL ;
- W !!,"Your current email address is set to: " W:$D(^PS(57.23,1,1)) $P($G(^PS(57.23,1,1)),"^",1) W !
- W !,"Please enter the email address: " R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1
- I X["?" D G SQAMAIL
- .W !!?5,"Enter an email address for receiving PPS-N download, install and error"
- .W !?5,"messages. This is used by SQA for a secondary email group if needed."
- .W !?5,"Typically an MS Outlook email address is defined since holders of the"
- .W !?5,"PSN PPS ADMIN key will continue to receive the NDF update messages. These"
- .W !?5,"messages include success, completion, error, and the report messages like"
- .W !?5," DATA UPDATE FROM NDF, etc."
- I X'=""&(X'="^")&($L(X)'=0)&(X'="?") D
- .S $P(^PS(57.23,1,1),"^",1)=X
- .W !!,"You changed the email address to: " W X
- .W ! K DIR S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- Q
- ;
- LOAD ;GET DOSE STUFF
- N DA1
- S J=2,X=$G(^PSDRUG(DA,"DOS")) I $P(X,"^"),$D(^PS(50.607,+$P(X,"^",2),0)) S ^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" STRENGTH: "_+X_"UNITS: "_$P(^PS(50.607,+$P(X,"^",2),0),"^"),J=J+1
- I $O(^PSDRUG(DA,"DOS1",0)) S ^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" POSSIBLE DOSES",^(J+1)=" DISP UNITS/DOSE DOSE PACKAGE BCMA UNITS/DOSE",DA1=0,J=J+2 D
- .F S DA1=$O(^PSDRUG(DA,"DOS1",DA1)) Q:'DA1 S X=^(DA1,0),^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" "_$J($P(X,"^"),4),$E(^(J),25)=$J($P(X,"^",2),4),$E(^(J),35)=$P(X,"^",3),$E(^(J),43)=$P(X,"^",4),J=J+1
- I $O(^PSDRUG(DA,"DOS2",0)) S ^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" LOCAL POSSIBLE DOSES",^(J+1)=" DOSE PACKAGE BCMA UNITS/DOSE",DA1=0,J=J+2 D
- .F S DA1=$O(^PSDRUG(DA,"DOS2",DA1)) Q:'DA1 S X=^(DA1,0),^TMP($J,INDX,NA_"^"_DA_"^"_IN,J)=" "_$P(X,"^"),$E(^(J),55)=$P(X,"^",2),$E(^(J),71)=$P(X,"^",3),J=J+1
- Q
- ;
- SETD(X) ;
- N PSOSX
- S PSOSX=$$GETOS^PSNFTP()
- I PSOSX["VMS" S $P(^PS(57.23,1,0),U,2)=X Q
- I PSOSX["LINUX" S $P(^PS(57.23,1,0),U,4)=X Q
- Q
- ;
- ENTER ; press enter key
- K DIR
- W ! S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNPPSNV 14232 printed Jan 18, 2025@03:25:51 Page 2
- PSNPPSNV ;HP/MJE-PPSN update NDF data additional update code ; 05 Mar 2014 1:20 PM
- +1 ;;4.0;NATIONAL DRUG FILE;**513,563,565**; 30 Oct 98;Build 16
- +2 ;Reference to ^PS(59.7 supported by DBIA #2613
- +3 ;
- +4 QUIT
- DATA ;Process DATA transactions
- +1 KILL FDA
- +2 SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="DATA"
- +3 DO UPDATE^DIE("","FDA","CTRLIEN")
- +4 KILL FDA
- +5 IF '$DATA(^TMP("PSN PPSN PARSED",$JOB,"DATA"))
- QUIT
- +6 NEW DA,I,J,K,LINE,PSN,ROOT,X
- +7 SET ROOT=$NAME(^TMP("PSN PPSN PARSED",$JOB,"DATA"))
- SET J=0
- +8 FOR
- SET J=$ORDER(@ROOT@(J))
- if 'J
- QUIT
- SET LINE=^(J)
- SET K=$LENGTH(LINE,"|")-1
- FOR I=1:1:K
- SET X=$PIECE(LINE,"|",I)
- SET ^TMP($JOB,$PIECE(X,"^"))=$PIECE(X,"^",2,4)
- +9 ; Updating GCNSEQNO, PREVIOUS GCNSEQNO and NDC LINK TO GCNSEQNO fields
- +10 SET DA=0
- FOR
- SET DA=$ORDER(^PSNDF(50.68,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +11 IF $DATA(^TMP($JOB,DA))
- SET $PIECE(^PSNDF(50.68,DA,1),"^",5,7)=$PIECE(^TMP($JOB,DA),"^",1,3)
- End DoDot:1
- +12 KILL ^TMP($JOB)
- +13 KILL DA,I,J,K,LINE,PSN,ROOT,X
- +14 QUIT
- +15 ;
- PMIUPDT ;Get PMI data and completly replace all globals 50.621-627
- +1 NEW FDA,DA,I,J,K,LINE,PSN,ROOT,X
- +2 SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="PMIDATA"
- +3 DO UPDATE^DIE("","FDA","CTRLIEN")
- +4 NEW FDA,DA,I,J,K,LINE,PSN,X
- +5 IF $DATA(^TMP("PSN PPSN PARSED",$JOB,"PMIDATA"))
- FOR PSN=50.621:.001:50.627
- KILL ^PS(PSN)
- +6 SET ROOT=$NAME(^TMP("PSN PPSN PARSED",$JOB,"DATA"))
- SET J=0
- +7 KILL ^TMP($JOB)
- +8 FOR
- SET J=$ORDER(@ROOT@(J))
- if 'J
- QUIT
- SET LINE=^(J)
- SET K=$LENGTH(LINE,"|")-1
- FOR I=1:1:K
- SET X=$PIECE(LINE,"|",I)
- SET ^TMP($JOB,$PIECE(X,"^"))=$PIECE(X,"^",2,4)
- +9 ; Updating GCNSEQNO, PREVIOUS GCNSEQNO and NDC LINK TO GCNSEQNO fields
- +10 SET DA=0
- FOR
- SET DA=$ORDER(^PSNDF(50.68,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +11 IF $DATA(^TMP($JOB,DA))
- SET $PIECE(^PSNDF(50.68,DA,1),"^",5,7)=$PIECE(^TMP($JOB,DA),"^",1,3)
- End DoDot:1
- +12 KILL ^TMP($JOB)
- +13 IF $DATA(^TMP("PSN PPSN PARSED",$JOB,"PMIDATA"))
- FOR PSN=50.621:.001:50.627
- MERGE ^PS(PSN)=^TMP("PSN PPSN PARSED",$JOB,"PMIDATA",PSN)
- +14 KILL DA,I,J,K,LINE,PSN,ROOT,X
- +15 QUIT
- +16 ;
- TASKIT(FREQ,START) ; create/update PSNTUPDT option start time and frequency
- +1 ; Input:
- +2 ; FREQ - Optional
- +3 ; START - Optional
- +4 ;
- +5 KILL PSERROR
- +6 DO NOW^%DTC
- SET %DT(0)=%
- SET %DT="EFATX"
- SET %DT("A")="Enter date/time: "
- DO ^%DT
- +7 IF (Y<0)!($DATA(DTOUT))
- WRITE !!,"No action taken!"
- DO ENTER
- WRITE @IOF
- QUIT
- +8 SET START=$$FMADD^XLFDT(Y,0,0,5)
- +9 ;
- +10 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +11 SET DIR("A")="Should this NDF update install be re-scheduled at the same time weekly"
- WRITE !!
- +12 SET DIR("B")="NO"
- DO ^DIR
- IF Y
- SET FREQ="7D"
- GOTO END
- +13 IF $DATA(DIRUT)
- WRITE !!,"No action taken!"
- DO ENTER
- WRITE @IOF
- QUIT
- +14 ;
- +15 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +16 SET DIR("A")="Should this NDF update install be re-scheduled at the same time daily"
- WRITE !!
- +17 SET DIR("B")="NO"
- DO ^DIR
- IF Y
- SET FREQ="1D"
- GOTO END
- +18 IF $DATA(DIRUT)
- WRITE !!,"No action taken!"
- DO ENTER
- WRITE @IOF
- QUIT
- +19 IF 'Y
- SET FREQ=""
- WRITE !!,"Warning! The download you have scheduled will occur only once."
- +20 ;
- END ;
- +1 IF FREQ=""
- DO RESCH^XUTMOPT("PSN TASK SCHEDULED INSTALL","@","","@")
- +2 WRITE !,"Your start time is:"
- +3 DO RESCH^XUTMOPT("PSN TASK SCHEDULED INSTALL",START,"",FREQ,"L",.PSERROR)
- +4 IF +FREQ=1
- WRITE !!,"The NDF update install will automatically be re-scheduled Daily",!
- +5 IF +FREQ=7
- WRITE !!,"The NDF update install will automatically be re-scheduled Weekly",!
- +6 IF FREQ=""
- WRITE !!,"The NDF update install will NOT automatically be re-scheduled",!
- +7 DO ENTER
- WRITE @IOF
- +8 QUIT
- +9 ;
- SCHDOPT ; edit option PSNTUPDT/PSN TASK SCHEDULE INSTALL to create and/or edit the scheduling date/time
- +1 ; Called from "PSN PPS SCHEDULE INSTALL" option to create and/or edit the scheduling
- +2 NEW PSNLEGF
- +3 IF '$DATA(^XUSEC("PSN PPS ADMIN",DUZ))
- Begin DoDot:1
- +4 WRITE !!,"You do not have the appropriate security key to use this option"
- +5 WRITE !,"please contact your ADPAC to resolve this issue.",!
- +6 SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +7 IF '$DATA(^XUSEC("PSN PPS ADMIN",DUZ))
- QUIT
- +8 SET PSNLEGF=""
- SET PSNLEGF=$$LEGACY^PSNPPSDL()
- IF PSNLEGF
- QUIT
- +9 WRITE !!!,"This option allows you to schedule a recurring TaskMan job to perform the NDF"
- +10 WRITE !,"update installation from PPS-N."
- +11 WRITE !!,"Warning! This NDF update install should be scheduled during non-peak hours."
- +12 WRITE !!,"You will need to select a date/time and how often this update should reoccur."
- +13 ;
- +14 ; print scheduled tasks
- DO SCHCK^PSNPPSDL("PSN TASK SCHEDULED INSTALL","I")
- +15 ;
- +16 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +17 SET DIR("A")="Do you want to schedule an automatic NDF update install in TaskMan"
- WRITE !!
- +18 SET DIR("B")="NO"
- +19 DO ^DIR
- +20 IF 'Y
- QUIT
- +21 NEW PSSROOT
- +22 DO TASKIT(15)
- +23 QUIT
- +24 ;
- PROMPT ;
- +1 WRITE @IOF
- IF '$DATA(^XUSEC("PSN PPS ADMIN",DUZ))
- Begin DoDot:1
- +2 WRITE !!,"You do not have the appropriate security key to use this option"
- +3 WRITE !,"please contact your ADPAC to resolve this issue.",!
- +4 SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +5 IF '$DATA(^XUSEC("PSN PPS ADMIN",DUZ))
- QUIT
- +6 WRITE !!,"This option allows a user to setup the following PPS-N configuration settings:"
- +7 WRITE !!,"1) The Cache host disk directory path that will be used for location of the"
- +8 WRITE !," PPS-N weekly NDF update file/s."
- +9 WRITE !!,"2) The last successful INSTALL version number of the PPS-N update file."
- +10 WRITE !," This is the UPDT option version number."
- +11 WRITE !!,"3) The last successful DOWNLOAD version number of the PPS-N update file."
- +12 WRITE !," This is the DNLD option version number."
- +13 WRITE !!,"4) The Exchange email Group or Individual email address that the PPS-N national"
- +14 WRITE !," and locally generated reports will be sent to."
- +15 WRITE !!,"5) The PPS-N mail group for the PPSN NATIONAL TEST SQA email status."
- +16 WRITE !!,"6) The Scheduled Options, Menu Options, and Protocols that should be paused"
- +17 WRITE !," while the PPS-n update file is processed."
- +18 WRITE !!,"7) The PPS-N NATIONAL SQA ACCOUNT (Q)A, (P)roduction, Product (S)upport"
- +19 WRITE !," or (T)est."
- +20 WRITE !
- +21 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- +22 if Y="^"!(Y=0)
- QUIT
- +23 WRITE @IOF,!!
- +24 WRITE !,"At the prompt please enter the specific VMS or Linux directory path name"
- +25 WRITE !,"where the PPS-N update file/s will be located. If you are not familiar with"
- +26 WRITE !,"the required information please consult your ADPAC."
- +27 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +28 SET DIR("A")="Do you want to change the disk directory path for PPS-N Update files"
- WRITE !
- +29 SET DIR("B")="NO"
- +30 DO ^DIR
- +31 if Y="^"
- QUIT
- +32 IF Y
- DO PATH
- +33 ;
- UPDT ;
- +1 WRITE @IOF,!!!,"At the prompt you can change the last successful update version number"
- +2 WRITE !,"of the PPS-N update file. This is for the UPDT option."
- +3 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +4 SET DIR("A")="Do you want to change the version number of the PPS-N Update files"
- WRITE !
- +5 SET DIR("B")="NO"
- +6 DO ^DIR
- +7 if Y="^"
- QUIT
- +8 IF Y
- DO INSTV
- +9 KILL DIRUT,DUOUT,DIR,X,Y
- DNLD ;
- +1 WRITE @IOF,!!!,"At the prompt you can change the last successful DOWNLOAD version number"
- +2 WRITE !,"of the PPS-N update file. This is for the DNLD option."
- +3 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +4 SET DIR("A")="Do you want to change the DOWNLOAD version number of the PPS-N files"
- WRITE !
- +5 SET DIR("B")="NO"
- +6 DO ^DIR
- +7 if Y="^"
- QUIT
- +8 IF Y
- DO DNLDV
- +9 KILL DIRUT,DUOUT,DIR,X,Y
- DEMAIL ;
- +1 WRITE @IOF,!!!,"At the prompt you can change the Exchange email Group or Individual"
- +2 WRITE !,"email address that the PPS-N national and locally generated reports"
- +3 WRITE !,"will be sent to."
- +4 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +5 SET DIR("A")="Do you want to change the email address for the PPS-N update reports"
- WRITE !
- +6 SET DIR("B")="NO"
- +7 DO ^DIR
- +8 if Y="^"
- QUIT
- +9 IF Y
- DO EMAIL
- +10 KILL DIRUT,DUOUT,DIR,X,Y
- +11 ;
- +12 WRITE @IOF,!!!,"At the prompt you can change the Exchange email Group or Individual"
- +13 WRITE !,"email address that the PPS-N PPSN NATIONAL TEST SQA emails will be sent to."
- +14 KILL DIRUT,DUOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +15 SET DIR("A")="Change the email address for the PPS-N PPSN NATIONAL TEST SQA emails"
- WRITE !
- +16 SET DIR("B")="NO"
- +17 DO ^DIR
- +18 if Y="^"
- QUIT
- +19 IF Y
- DO SQAMAIL
- +20 KILL DIRUT,DUOUT,DIR,X,Y
- +21 ;
- +22 DO DISOPTS^PSNPPSNR
- +23 KILL DIRUT,DUOUT,DIR,X,Y
- TYPE ;
- +1 WRITE @IOF,!!!,"At the prompt you can change the PPS-N NATIONAL SQA ACCOUNT"
- +2 KILL DIRUT,DUOUT,DTOUT,DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("?")="Please enter Y or N."
- +3 SET DIR("A")="Do you want to change the PPS-N PPSN NATIONAL TEST SQA"
- WRITE !
- +4 SET DIR("B")="NO"
- +5 DO ^DIR
- +6 if Y="^"!('Y)
- QUIT
- TYPE2 ;
- +1 NEW TYPE
- +2 SET TYPE=""
- SET TYPE=$PIECE($GET(^PS(59.7,1,10)),"^",12)
- +3 WRITE !!,"Your current PPS-N NATIONAL SQA ACCOUNT is set to: "
- WRITE TYPE_" "_$SELECT(TYPE="Q":"for National SQA Testing",TYPE="P":"for Production",TYPE="T":"for Test Account",TYPE="S":"for Product Support",1:"")
- +4 ;W !!,"Please enter PPS-N NATIONAL SQA ACCOUNT"
- TYPE3 ;
- +1 WRITE !,"P = Production",?40,"T = Test Account"
- +2 WRITE !,"S = Product Support",?40,"Q = QA National Testing"
- +3 WRITE !,"N = QA NDFMS",!
- +4 READ !,"Enter selection: ",X:$SELECT($DATA(DTIME):DTIME,1:300)
- IF '$TEST
- SET DTOUT=1
- +5 IF X["?"
- Begin DoDot:1
- +6 WRITE !!?5,"This parameter determines if the system is SQA National Testing site,"
- +7 WRITE !?5,"Testing Account, Product Support or a Production site. Enter P for"
- +8 WRITE !,?5,"Production, T for Test Account, S for Product Support, Q for SQA"
- +9 WRITE !,?5,"National Testing or N for QA NDFMS account.",!
- +10 WRITE !!?5,"Local sites should define this parameter as P for Production or T for"
- +11 WRITE !?5,"their Test Account. Product support should use S. SQA National Testing"
- +12 WRITE !?5,"should team should have one account defined Q for QA, a different"
- +13 WRITE !?5,"account for P for Production, and another for N for QA NDFMS."
- End DoDot:1
- GOTO TYPE2
- +14 if X="^"
- QUIT
- +15 IF ",S,Q,T,P,N,"'[(","_X_",")
- WRITE !!,"You must enter P, T, S, Q or N",!
- GOTO TYPE2
- +16 IF X'=""&(X'="^")&($LENGTH(X)'=0)
- Begin DoDot:1
- +17 SET $PIECE(^PS(59.7,1,10),"^",12)=X
- +18 WRITE !!,"You changed the PPS-N NATIONAL SQA ACCOUNT to: "
- WRITE X
- +19 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +20 KILL DIRUT,DUOUT,DIR,X,Y
- +21 QUIT
- +22 ;
- PATH ;
- +1 WRITE !!,"Your current update file path is set to: ",$$GETD^PSNFTP()
- +2 WRITE !!,"Please enter the complete directory path: "
- READ X:$SELECT($DATA(DTIME):DTIME,1:300)
- IF '$TEST
- SET DTOUT=1
- +3 IF X["?"
- Begin DoDot:1
- +4 WRITE !!?5,"Enter the operating system full directory path where the PPS-N Update",!?5,"file(s) will be stored."
- +5 WRITE " Refer to the NDF Technical manual and/or",!?5,"contact your IRM for more information."
- +6 WRITE !?10,"Example: ABC$:[USER.PPSN]"
- End DoDot:1
- GOTO PATH
- +7 IF X'=""&(X'="^")&(X'="?")
- Begin DoDot:1
- +8 DO SETD(X)
- +9 WRITE !!,"You changed the directory path to: "
- WRITE X
- +10 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +11 QUIT
- +12 ;
- INSTV ;
- +1 WRITE !!,"Your current PPS-N INSTALL file version number is set to: "
- if $DATA(^PS(57.23,1,0))
- WRITE $PIECE(^PS(57.23,1,0),"^",3)
- WRITE !
- +2 WRITE !,"Please enter the current PPS-N update file version number: "
- READ X:$SELECT($DATA(DTIME):DTIME,1:300)
- IF '$TEST
- SET DTOUT=1
- +3 IF X["?"
- Begin DoDot:1
- +4 WRITE !!?5,"Enter the last file version installed on the system. If the last file"
- +5 WRITE !?5,"name installed was PPS_15PRV_16NEW.DAT, the last file version would be 16."
- End DoDot:1
- GOTO INSTV
- +6 IF X'=""&(X'="^")&($LENGTH(X)'=0)&(X'="?")
- Begin DoDot:1
- +7 SET $PIECE(^PS(57.23,1,0),"^",3)=X
- +8 WRITE !!,"You changed the INSTALL file version number to: "
- WRITE X
- +9 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +10 QUIT
- +11 ;
- DNLDV ;
- +1 WRITE !!,"Your current PPS-N DOWNLOAD file version number is set to: "
- if $DATA(^PS(57.23,1,0))
- WRITE $PIECE(^PS(57.23,1,0),"^",7)
- WRITE !
- +2 WRITE !,"Please enter the current PPS-N DOWNLOAD file version number: "
- READ X:$SELECT($DATA(DTIME):DTIME,1:300)
- IF '$TEST
- SET DTOUT=1
- +3 IF X["?"
- Begin DoDot:1
- +4 WRITE !!?5,"Enter the last file version downloaded to the system. If the last file"
- +5 WRITE !?5,"name downloaded was PPS_15PRV_16NEW.DAT, the last file version would be 16."
- End DoDot:1
- GOTO DNLDV
- +6 IF X'=""&(X'="^")&($LENGTH(X)'=0)&(X'="?")
- Begin DoDot:1
- +7 SET $PIECE(^PS(57.23,1,0),"^",7)=X
- +8 WRITE !!,"You changed the DOWNLOAD file version number to: "
- WRITE X
- +9 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +10 QUIT
- +11 ;
- EMAIL ;
- +1 WRITE !!,"Your current email address is set to: "
- if $DATA(^PS(57.23,1,0))
- WRITE $PIECE($GET(^PS(57.23,1,0)),"^",6)
- WRITE !
- +2 WRITE !,"Please enter the email address: "
- READ X:$SELECT($DATA(DTIME):DTIME,1:300)
- IF '$TEST
- SET DTOUT=1
- +3 IF X["?"
- Begin DoDot:1
- +4 WRITE !!?5,"Enter an email address for receiving PPS-N download, install and error"
- +5 WRITE !?5,"messages. This is typically an MS Outlook email address since holders "
- +6 WRITE !?5,"of the PSN PPS ADMIN key will continue to receive the NDF update messages."
- +7 WRITE !?5,"These messages include success, completion, error, and the report"
- +8 WRITE !?5,"messages like DATA UPDATE FROM NDF, etc."
- End DoDot:1
- GOTO EMAIL
- +9 IF X'=""&(X'="^")&($LENGTH(X)'=0)&(X'="?")
- Begin DoDot:1
- +10 SET $PIECE(^PS(57.23,1,0),"^",6)=X
- +11 WRITE !!,"You changed the email address to: "
- WRITE X
- +12 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +13 QUIT
- +14 ;
- SQAMAIL ;
- +1 WRITE !!,"Your current email address is set to: "
- if $DATA(^PS(57.23,1,1))
- WRITE $PIECE($GET(^PS(57.23,1,1)),"^",1)
- WRITE !
- +2 WRITE !,"Please enter the email address: "
- READ X:$SELECT($DATA(DTIME):DTIME,1:300)
- IF '$TEST
- SET DTOUT=1
- +3 IF X["?"
- Begin DoDot:1
- +4 WRITE !!?5,"Enter an email address for receiving PPS-N download, install and error"
- +5 WRITE !?5,"messages. This is used by SQA for a secondary email group if needed."
- +6 WRITE !?5,"Typically an MS Outlook email address is defined since holders of the"
- +7 WRITE !?5,"PSN PPS ADMIN key will continue to receive the NDF update messages. These"
- +8 WRITE !?5,"messages include success, completion, error, and the report messages like"
- +9 WRITE !?5," DATA UPDATE FROM NDF, etc."
- End DoDot:1
- GOTO SQAMAIL
- +10 IF X'=""&(X'="^")&($LENGTH(X)'=0)&(X'="?")
- Begin DoDot:1
- +11 SET $PIECE(^PS(57.23,1,1),"^",1)=X
- +12 WRITE !!,"You changed the email address to: "
- WRITE X
- +13 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +14 QUIT
- +15 ;
- LOAD ;GET DOSE STUFF
- +1 NEW DA1
- +2 SET J=2
- SET X=$GET(^PSDRUG(DA,"DOS"))
- IF $PIECE(X,"^")
- IF $DATA(^PS(50.607,+$PIECE(X,"^",2),0))
- SET ^TMP($JOB,INDX,NA_"^"_DA_"^"_IN,J)=" STRENGTH: "_+X_"UNITS: "_$PIECE(^PS(50.607,+$PIECE(X,"^",2),0),"^")
- SET J=J+1
- +3 IF $ORDER(^PSDRUG(DA,"DOS1",0))
- SET ^TMP($JOB,INDX,NA_"^"_DA_"^"_IN,J)=" POSSIBLE DOSES"
- SET ^(J+1)=" DISP UNITS/DOSE DOSE PACKAGE BCMA UNITS/DOSE"
- SET DA1=0
- SET J=J+2
- Begin DoDot:1
- +4 FOR
- SET DA1=$ORDER(^PSDRUG(DA,"DOS1",DA1))
- if 'DA1
- QUIT
- SET X=^(DA1,0)
- SET ^TMP($JOB,INDX,NA_"^"_DA_"^"_IN,J)=" "_$JUSTIFY($PIECE(X,"^"),4)
- SET $EXTRACT(^(J),25)=$JUSTIFY($PIECE(X,"^",2),4)
- SET $EXTRACT(^(J),35)=$PIECE(X,"^",3)
- SET $EXTRACT(^(J),43)=$PIECE(X,"^",4)
- SET J=J+1
- End DoDot:1
- +5 IF $ORDER(^PSDRUG(DA,"DOS2",0))
- SET ^TMP($JOB,INDX,NA_"^"_DA_"^"_IN,J)=" LOCAL POSSIBLE DOSES"
- SET ^(J+1)=" DOSE PACKAGE BCMA UNITS/DOSE"
- SET DA1=0
- SET J=J+2
- Begin DoDot:1
- +6 FOR
- SET DA1=$ORDER(^PSDRUG(DA,"DOS2",DA1))
- if 'DA1
- QUIT
- SET X=^(DA1,0)
- SET ^TMP($JOB,INDX,NA_"^"_DA_"^"_IN,J)=" "_$PIECE(X,"^")
- SET $EXTRACT(^(J),55)=$PIECE(X,"^",2)
- SET $EXTRACT(^(J),71)=$PIECE(X,"^",3)
- SET J=J+1
- End DoDot:1
- +7 QUIT
- +8 ;
- SETD(X) ;
- +1 NEW PSOSX
- +2 SET PSOSX=$$GETOS^PSNFTP()
- +3 IF PSOSX["VMS"
- SET $PIECE(^PS(57.23,1,0),U,2)=X
- QUIT
- +4 IF PSOSX["LINUX"
- SET $PIECE(^PS(57.23,1,0),U,4)=X
- QUIT
- +5 QUIT
- +6 ;
- ENTER ; press enter key
- +1 KILL DIR
- +2 WRITE !
- SET DIR(0)="E"
- SET DIR("A")=" Press ENTER to Continue"
- DO ^DIR
- KILL DIR
- +3 QUIT