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 Dec 13, 2024@02:24:50 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
