PSNPARM ;BIR/SJA-PPS-N Site Parameters ; 11/16/2016
;;4.0;NATIONAL DRUG FILE;**513,573**; 30 Oct 98;Build 6
;
;Reference to ^PS(59.7 supported by DBIA #2613
;Reference to ^VA(200 supported by DBIA #10060
;Reference to ^XUSEC supported by DBIA #10076
;Reference to ^ORD(101 supported by DBIA #872
;Reference to ^DIC(19.2 supported by DBIA #1472
;Reference to ^DIC(19 supported by DBIA #2246
;
EN ; -- option entry point
N CURLEY,FLDS,LN,PSNAR,PSNLCK,PSNNOW,PSNNOW1,PSNOUT,PSNTAG,PSNUSER,PSNX,SHEMP,TYPE,X,XX,Y,Z
N NODE0,NODE1,NODE2,NOD597,PSNFLD,PSNJ,PSNZ,REQFLDS,IORVON,IORVOFF
S PSNOUT=0,REQFLDS="^3^4^5^6^7^10^11^12^13^"
S X="IORVON;IORVOFF" D ENDR^%ZISS
;
ASK ; -- screen display
G:PSNOUT END D DISP
W !!,"Select field number to Edit: " R X:DTIME I '$T!("^"[X) S PSNOUT=1 G END
S X=$S(X="a":"A",1:X) I '$D(PSNAR(X)),(X'?.N1":".N),(X'="A") D HELP G:PSNOUT END G ASK
I X="A" S X="1:14"
I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>14)!(Y>Z) D HELP G:PSNOUT END G ASK
D HDR
I X?.N1":".N D RANGE G ASK
I $D(PSNAR(X)) S FLDS=X W ! D G ASK
.I $$LOCK W ! D ONE,UNLOCK
;
END ; -- kill variables and quit
W @IOF
K CURLEY,FLDS,LN,PSNAR,PSNLCK,PSNNOW,PSNNOW1,PSNOUT,PSNTAG,PSNUSER,PSNX,SHEMP,TYPE,X,Y,Z
K NODE0,NODE1,NODE2,NOD597,PSNFLD,PSNJ,PSNZ,REQFLDS
Q
RANGE ; -- range of numbers
I $$LOCK D D UNLOCK
.W !! S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F FLDS=SHEMP:1:CURLEY Q:PSNOUT D ONE
Q
ONE ; -- edit one item
I FLDS=14 D DISOPTS^PSNPPSNR Q
I REQFLDS[("^"_FLDS_"^"),'$D(^XUSEC("PSN PPS COORD",DUZ)) D ERR Q
I FLDS=4,($P($G(^PS(57.23,1,0)),"^",4)="") D RDIR
K DR,DIE,DA S DA=1,DR=$P(PSNAR(FLDS),"^",3)_"T",DIE=$P(PSNAR(FLDS),"^",2) D ^DIE K DR,DA I $D(Y) S PSNOUT=1
I FLDS=7 W !!,"Press <RET> to continue, or '^' to quit ",$C(7) R XX:DTIME I '$T!(XX["^") S PSNOUT=1
I FLDS=10,($P(^PS(57.23,1,0),"^",10)="Y"&("QN"[($P(^PS(59.7,1,10),"^",12)))) D
. S $P(^PS(57.23,1,0),"^",10)="N" S FLDS=11,$P(PSNAR(11),"^")="NO" G ONE
Q
HDR ; -- print screen header
S $P(LN,"-",80)="" W @IOF,!
W !,"Pharmacy Product System-National(PPS-N) Site Parameters",!,LN,!
Q
LOCK() ; -- apply incremental lock
N PSNNOW,PSNNOW1,PSNTAG
S PSNNOW=$$NOW^XLFDT,PSNNOW1=$$FMADD^XLFDT(PSNNOW,,2)
S PSNLCK=1,PSNTAG=""
L +^XTMP("PSNPARM"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
E D L1 S PSNLCK=0 Q PSNLCK
D:PSNLCK XTMP
Q PSNLCK
;
UNLOCK() ; -- apply decremental lock
L -^XTMP("PSNPARM")
K ^XTMP("PSNPARM")
Q
XTMP S ^XTMP("PSNPARM",0)=PSNNOW1_"^"_PSNNOW_"^PSN Site Parameters Lock"_PSNTAG_"^"_$J,^XTMP("PSNPARM",$J,DUZ)=""
Q
L1 S PSNX="",PSNUSER="Another person",PSNX=$O(^XTMP("PSNPARM",$J,0))
I PSNX S PSNUSER=$P($G(^VA(200,PSNX,0)),"^")
D EN^DDIOL(PSNUSER_" is editing the PPS-N site Parameters. Please try again later.","","!,$C(7)") H 3
Q
DISP ; -- displays parameters
S $P(LN,"-",80)="" D HDR
S NODE0=$G(^PS(57.23,1,0)),NODE1=$G(^PS(57.23,1,1)),NODE2=$G(^PS(57.23,1,2))
S NOD597=$G(^PS(59.7,1,10)),TYPE=$S($P(NOD597,"^",12)]"":$P(NOD597,"^",12),1:"")
I TYPE]"" S TYPE=TYPE_" - "_$S(TYPE="Q":"National SQA Testing",TYPE="P":"Production",TYPE="T":"Test Account",TYPE="S":"Product Support",TYPE="N":"QA NDFMS",1:"")
F PSNJ=1:1 S PSNFLD=$P($T(FIELD+PSNJ),";;",2) Q:PSNFLD=""!(PSNFLD="END") S PSNZ(PSNJ)=$P(PSNFLD,"^",2)
S PSNAR(1)=$P(NODE0,"^",3)_"^57.23^2",PSNAR(2)=$P(NODE0,"^",7)_"^57.23^8"
S PSNAR(3)=$P(NODE0,"^",2)_"^57.23^1",PSNAR(4)=$P(NODE0,"^",4)_"^57.23^3",PSNAR(5)=$P(NODE2,"^")_"^57.23^20"
S PSNAR(6)=$P(NODE2,"^",2)_"^57.23^21",PSNAR(7)=$P(NODE2,"^",3)_"^57.23^22"
S PSNAR(8)=$P(NODE0,"^",6)_"^57.23^5",PSNAR(9)=$P(NODE1,"^")_"^57.23^6",PSNAR(10)=TYPE_"^59.7^17"
S PSNAR(11)=$S($P(NODE0,"^",10)="Y":"YES",$P(NODE0,"^",10)="N":"NO",1:"")_"^57.23^45"
S PSNAR(12)=$S($P(NODE0,"^",8)="Y":"IN PROGRESS",1:"NOT IN PROGRESS")_"^57.23^9"
S PSNAR(13)=$S($P(NODE0,"^",9)="Y":"IN PROGRESS",1:"NOT IN PROGRESS")_"^57.23^10"
S PSNAR(14)=IORVON_$S($$DISBL():"<DATA>",1:"")_IORVOFF
F PSNJ=1:1 Q:'$D(PSNZ(PSNJ)) W !,$$RJ^XLFSTR((PSNJ_"."),3," ")," ",$S(REQFLDS[("^"_PSNJ_"^"):"*",1:" "),PSNZ(PSNJ),?33,": ",$P(PSNAR(PSNJ),"^")
W !,LN
Q
HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper",!,"responses are listed below."
W !!,"An '*' (asterisk) before the field indicates that an additional security key is required."
W !!,"1. Enter 'A' to update all information."
W !!,"2. Enter a specific number to update the information in that field. (For",!," example, enter '1' to Update File Version Counter)"
W !!,"3. Enter a range of numbers separated by a ':' to enter a range of",!," information. (For example, enter '1:3' to enter PPS-N Install Version,",!," PPS-N Download Version, and Open VMS Local Directory.)"
W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S PSNOUT=1
Q
ERR ; -- display error message
W !,PSNZ(FLDS)," :",$P(PSNAR(FLDS),"^"),!
W !,"Security key 'PSN PPS COORD' is required for editing this field."_$C(7)
W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S PSNOUT=1 Q
W !!
Q
DISBL() ; -- check for out of order scheduled option/menu option/protocol
N X,I,ICNT,ND,SOPT K ^TMP("PSN PPSN PARSED",$J)
S ICNT=0 F ND="3:19.2","3.1:19","3.2:101" D
.S X=0 F S X=$O(^PS(57.23,1,+ND,"B",X)) Q:'X S I=0 F S I=$O(^PS(57.23,1,+ND,"B",X,I)) Q:'I D
..S SOPT=$$GET1^DIQ($P(ND,":",2),X,.01,"E") S:SOPT'="" ICNT=ICNT+1,^TMP("PSN PPSN PARSED",$J,SOPT,ICNT)=I
I $D(^TMP("PSN PPSN PARSED",$J)) K ^TMP("PSN PPSN PARSED",$J) Q 1
Q 0
;
RDIR ; -- recomended Unix dirrectory
N RUXDIR S RUXDIR=""
S RUXDIR=$$LXDIR() I RUXDIR="" Q
W !,"*** The recommended Unix/Linux Local Directory is ",RUXDIR,$C(7),!
Q
UNXLDIR ; -- Unix/Linux Local Directory
;*573 Added condition check for IRIS
N UNXLD,NDIR,DIR,DUOUT,DTOUT,PSNVER
S PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
I $$OS^%ZOSV()'="UNIX" Q
I PSNVER'["CACHE",PSNVER'["IRIS" Q
I $G(X)'="",$E(X,$L(X))'="/" S X=X_"/"
S UNXLD=X
I UNXLD'="",'$$DIREXIST^PSNFTP2(UNXLD) W ! D
. S DIR("A",1)="The directory above could not be found.",DIR("A",2)=""
. S DIR("A")="Would you like to create it now",DIR(0)="Y",DIR("B")="N"
. D ^DIR I $G(DTOUT)!$G(DUOUT)!'Y S X=UNXLD W ! Q
. S X=UNXLD
. D MAKEDIR^PSNFTP2(UNXLD) S NDIR=1 W !
. I '$$DIREXIST^PSNFTP2(UNXLD) D
. . W !!,"Warning: "_$S($G(NDIR):"The directory could not be created.",1:"The directory could not be found and is required for PPSN update file download."),!,$C(7)
. . K DIR S DIR(0)="FOA",DIR("A")=" Press <RET> to continue, or '^' to quit " D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSNOUT=1
Q
;
LXDIR() ; -- Returns the Linux Directory for PPSN sFTP
;*573 Added condition check for IRIS
N CURDIR,ROOTDIR,PSNVER
S PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
I $$OS^%ZOSV()'="UNIX" Q ""
I PSNVER'["CACHE",PSNVER'["IRIS" Q ""
; Retrieving the current directory
X "S CURDIR=$ZU(12)" S ROOTDIR=$P(CURDIR,"/",1,4)
I $E(ROOTDIR,$L(ROOTDIR))="/" S $E(ROOTDIR,$L(ROOTDIR))=""
Q ROOTDIR_"/user/sftp/PPSN/"
;
SCR(Y) ; -- screen entry to the Legacy Update Processing field
N TYPE,OK
S TYPE=$P(^PS(59.7,1,10),"^",12),OK=1
I "QN"[TYPE,Y="Y" S OK=0
Q OK
;
STRIP(X) ; strip control chrs and any other invalid characters
N II,YY,CHR
; remove control characters & special chars
S YY="" F II=1:1:$L(X) I $A(X,II)>31 S YY=YY_$E(X,II)
S CHR="!#%&*)({} " F II=1:1:$L(CHR) I YY[$E(CHR,II) S YY=$$STRIP^XLFSTR(YY,$E(CHR,II))
Q YY
;
FIELD ; -- field name
;;1^PPS-N Install Version
;;2^PPS-N Download Version
;;3^Open VMS Local Directory
;;4^Unix/Linux Local Directory
;;5^Remote Server Address
;;6^Remote Server Directory
;;7^Remote SFTP Username
;;8^Primary PPS-N Mail Group
;;9^Secondary PPS-N Mail group
;;10^PPS-N Account Type
;;11^Legacy Update Processing
;;12^Download Status
;;13^Install Status
;;14^Disable Menus, Options, etc
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNPARM 7977 printed Apr 09, 2024@21:24:31 Page 2
PSNPARM ;BIR/SJA-PPS-N Site Parameters ; 11/16/2016
+1 ;;4.0;NATIONAL DRUG FILE;**513,573**; 30 Oct 98;Build 6
+2 ;
+3 ;Reference to ^PS(59.7 supported by DBIA #2613
+4 ;Reference to ^VA(200 supported by DBIA #10060
+5 ;Reference to ^XUSEC supported by DBIA #10076
+6 ;Reference to ^ORD(101 supported by DBIA #872
+7 ;Reference to ^DIC(19.2 supported by DBIA #1472
+8 ;Reference to ^DIC(19 supported by DBIA #2246
+9 ;
EN ; -- option entry point
+1 NEW CURLEY,FLDS,LN,PSNAR,PSNLCK,PSNNOW,PSNNOW1,PSNOUT,PSNTAG,PSNUSER,PSNX,SHEMP,TYPE,X,XX,Y,Z
+2 NEW NODE0,NODE1,NODE2,NOD597,PSNFLD,PSNJ,PSNZ,REQFLDS,IORVON,IORVOFF
+3 SET PSNOUT=0
SET REQFLDS="^3^4^5^6^7^10^11^12^13^"
+4 SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
+5 ;
ASK ; -- screen display
+1 if PSNOUT
GOTO END
DO DISP
+2 WRITE !!,"Select field number to Edit: "
READ X:DTIME
IF '$TEST!("^"[X)
SET PSNOUT=1
GOTO END
+3 SET X=$SELECT(X="a":"A",1:X)
IF '$DATA(PSNAR(X))
IF (X'?.N1":".N)
IF (X'="A")
DO HELP
if PSNOUT
GOTO END
GOTO ASK
+4 IF X="A"
SET X="1:14"
+5 IF X?.N1":".N
SET Y=$EXTRACT(X)
SET Z=$PIECE(X,":",2)
IF Y<1!(Z>14)!(Y>Z)
DO HELP
if PSNOUT
GOTO END
GOTO ASK
+6 DO HDR
+7 IF X?.N1":".N
DO RANGE
GOTO ASK
+8 IF $DATA(PSNAR(X))
SET FLDS=X
WRITE !
Begin DoDot:1
+9 IF $$LOCK
WRITE !
DO ONE
DO UNLOCK
End DoDot:1
GOTO ASK
+10 ;
END ; -- kill variables and quit
+1 WRITE @IOF
+2 KILL CURLEY,FLDS,LN,PSNAR,PSNLCK,PSNNOW,PSNNOW1,PSNOUT,PSNTAG,PSNUSER,PSNX,SHEMP,TYPE,X,Y,Z
+3 KILL NODE0,NODE1,NODE2,NOD597,PSNFLD,PSNJ,PSNZ,REQFLDS
+4 QUIT
RANGE ; -- range of numbers
+1 IF $$LOCK
Begin DoDot:1
+2 WRITE !!
SET SHEMP=$PIECE(X,":")
SET CURLEY=$PIECE(X,":",2)
FOR FLDS=SHEMP:1:CURLEY
if PSNOUT
QUIT
DO ONE
End DoDot:1
DO UNLOCK
+3 QUIT
ONE ; -- edit one item
+1 IF FLDS=14
DO DISOPTS^PSNPPSNR
QUIT
+2 IF REQFLDS[("^"_FLDS_"^")
IF '$DATA(^XUSEC("PSN PPS COORD",DUZ))
DO ERR
QUIT
+3 IF FLDS=4
IF ($PIECE($GET(^PS(57.23,1,0)),"^",4)="")
DO RDIR
+4 KILL DR,DIE,DA
SET DA=1
SET DR=$PIECE(PSNAR(FLDS),"^",3)_"T"
SET DIE=$PIECE(PSNAR(FLDS),"^",2)
DO ^DIE
KILL DR,DA
IF $DATA(Y)
SET PSNOUT=1
+5 IF FLDS=7
WRITE !!,"Press <RET> to continue, or '^' to quit ",$CHAR(7)
READ XX:DTIME
IF '$TEST!(XX["^")
SET PSNOUT=1
+6 IF FLDS=10
IF ($PIECE(^PS(57.23,1,0),"^",10)="Y"&("QN"[($PIECE(^PS(59.7,1,10),"^",12))))
Begin DoDot:1
+7 SET $PIECE(^PS(57.23,1,0),"^",10)="N"
SET FLDS=11
SET $PIECE(PSNAR(11),"^")="NO"
GOTO ONE
End DoDot:1
+8 QUIT
HDR ; -- print screen header
+1 SET $PIECE(LN,"-",80)=""
WRITE @IOF,!
+2 WRITE !,"Pharmacy Product System-National(PPS-N) Site Parameters",!,LN,!
+3 QUIT
LOCK() ; -- apply incremental lock
+1 NEW PSNNOW,PSNNOW1,PSNTAG
+2 SET PSNNOW=$$NOW^XLFDT
SET PSNNOW1=$$FMADD^XLFDT(PSNNOW,,2)
+3 SET PSNLCK=1
SET PSNTAG=""
+4 LOCK +^XTMP("PSNPARM"):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
+5 IF '$TEST
DO L1
SET PSNLCK=0
QUIT PSNLCK
+6 if PSNLCK
DO XTMP
+7 QUIT PSNLCK
+8 ;
UNLOCK() ; -- apply decremental lock
+1 LOCK -^XTMP("PSNPARM")
+2 KILL ^XTMP("PSNPARM")
+3 QUIT
XTMP SET ^XTMP("PSNPARM",0)=PSNNOW1_"^"_PSNNOW_"^PSN Site Parameters Lock"_PSNTAG_"^"_$JOB
SET ^XTMP("PSNPARM",$JOB,DUZ)=""
+1 QUIT
L1 SET PSNX=""
SET PSNUSER="Another person"
SET PSNX=$ORDER(^XTMP("PSNPARM",$JOB,0))
+1 IF PSNX
SET PSNUSER=$PIECE($GET(^VA(200,PSNX,0)),"^")
+2 DO EN^DDIOL(PSNUSER_" is editing the PPS-N site Parameters. Please try again later.","","!,$C(7)")
HANG 3
+3 QUIT
DISP ; -- displays parameters
+1 SET $PIECE(LN,"-",80)=""
DO HDR
+2 SET NODE0=$GET(^PS(57.23,1,0))
SET NODE1=$GET(^PS(57.23,1,1))
SET NODE2=$GET(^PS(57.23,1,2))
+3 SET NOD597=$GET(^PS(59.7,1,10))
SET TYPE=$SELECT($PIECE(NOD597,"^",12)]"":$PIECE(NOD597,"^",12),1:"")
+4 IF TYPE]""
SET TYPE=TYPE_" - "_$SELECT(TYPE="Q":"National SQA Testing",TYPE="P":"Production",TYPE="T":"Test Account",TYPE="S":"Product Support",TYPE="N":"QA NDFMS",1:"")
+5 FOR PSNJ=1:1
SET PSNFLD=$PIECE($TEXT(FIELD+PSNJ),";;",2)
if PSNFLD=""!(PSNFLD="END")
QUIT
SET PSNZ(PSNJ)=$PIECE(PSNFLD,"^",2)
+6 SET PSNAR(1)=$PIECE(NODE0,"^",3)_"^57.23^2"
SET PSNAR(2)=$PIECE(NODE0,"^",7)_"^57.23^8"
+7 SET PSNAR(3)=$PIECE(NODE0,"^",2)_"^57.23^1"
SET PSNAR(4)=$PIECE(NODE0,"^",4)_"^57.23^3"
SET PSNAR(5)=$PIECE(NODE2,"^")_"^57.23^20"
+8 SET PSNAR(6)=$PIECE(NODE2,"^",2)_"^57.23^21"
SET PSNAR(7)=$PIECE(NODE2,"^",3)_"^57.23^22"
+9 SET PSNAR(8)=$PIECE(NODE0,"^",6)_"^57.23^5"
SET PSNAR(9)=$PIECE(NODE1,"^")_"^57.23^6"
SET PSNAR(10)=TYPE_"^59.7^17"
+10 SET PSNAR(11)=$SELECT($PIECE(NODE0,"^",10)="Y":"YES",$PIECE(NODE0,"^",10)="N":"NO",1:"")_"^57.23^45"
+11 SET PSNAR(12)=$SELECT($PIECE(NODE0,"^",8)="Y":"IN PROGRESS",1:"NOT IN PROGRESS")_"^57.23^9"
+12 SET PSNAR(13)=$SELECT($PIECE(NODE0,"^",9)="Y":"IN PROGRESS",1:"NOT IN PROGRESS")_"^57.23^10"
+13 SET PSNAR(14)=IORVON_$SELECT($$DISBL():"<DATA>",1:"")_IORVOFF
+14 FOR PSNJ=1:1
if '$DATA(PSNZ(PSNJ))
QUIT
WRITE !,$$RJ^XLFSTR((PSNJ_"."),3," ")," ",$SELECT(REQFLDS[("^"_PSNJ_"^"):"*",1:" "),PSNZ(PSNJ),?33,": ",$PIECE(PSNAR(PSNJ),"^")
+15 WRITE !,LN
+16 QUIT
HELP WRITE @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper",!,"responses are listed below."
+1 WRITE !!,"An '*' (asterisk) before the field indicates that an additional security key is required."
+2 WRITE !!,"1. Enter 'A' to update all information."
+3 WRITE !!,"2. Enter a specific number to update the information in that field. (For",!," example, enter '1' to Update File Version Counter)"
+4 WRITE !!,"3. Enter a range of numbers separated by a ':' to enter a range of",!," information. (For example, enter '1:3' to enter PPS-N Install Version,",!," PPS-N Download Version, and Open VMS Local Directory.)"
+5 WRITE !!,"Press <RET> to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET PSNOUT=1
+6 QUIT
ERR ; -- display error message
+1 WRITE !,PSNZ(FLDS)," :",$PIECE(PSNAR(FLDS),"^"),!
+2 WRITE !,"Security key 'PSN PPS COORD' is required for editing this field."_$CHAR(7)
+3 WRITE !!,"Press <RET> to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET PSNOUT=1
QUIT
+4 WRITE !!
+5 QUIT
DISBL() ; -- check for out of order scheduled option/menu option/protocol
+1 NEW X,I,ICNT,ND,SOPT
KILL ^TMP("PSN PPSN PARSED",$JOB)
+2 SET ICNT=0
FOR ND="3:19.2","3.1:19","3.2:101"
Begin DoDot:1
+3 SET X=0
FOR
SET X=$ORDER(^PS(57.23,1,+ND,"B",X))
if 'X
QUIT
SET I=0
FOR
SET I=$ORDER(^PS(57.23,1,+ND,"B",X,I))
if 'I
QUIT
Begin DoDot:2
+4 SET SOPT=$$GET1^DIQ($PIECE(ND,":",2),X,.01,"E")
if SOPT'=""
SET ICNT=ICNT+1
SET ^TMP("PSN PPSN PARSED",$JOB,SOPT,ICNT)=I
End DoDot:2
End DoDot:1
+5 IF $DATA(^TMP("PSN PPSN PARSED",$JOB))
KILL ^TMP("PSN PPSN PARSED",$JOB)
QUIT 1
+6 QUIT 0
+7 ;
RDIR ; -- recomended Unix dirrectory
+1 NEW RUXDIR
SET RUXDIR=""
+2 SET RUXDIR=$$LXDIR()
IF RUXDIR=""
QUIT
+3 WRITE !,"*** The recommended Unix/Linux Local Directory is ",RUXDIR,$CHAR(7),!
+4 QUIT
UNXLDIR ; -- Unix/Linux Local Directory
+1 ;*573 Added condition check for IRIS
+2 NEW UNXLD,NDIR,DIR,DUOUT,DTOUT,PSNVER
+3 SET PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
+4 IF $$OS^%ZOSV()'="UNIX"
QUIT
+5 IF PSNVER'["CACHE"
IF PSNVER'["IRIS"
QUIT
+6 IF $GET(X)'=""
IF $EXTRACT(X,$LENGTH(X))'="/"
SET X=X_"/"
+7 SET UNXLD=X
+8 IF UNXLD'=""
IF '$$DIREXIST^PSNFTP2(UNXLD)
WRITE !
Begin DoDot:1
+9 SET DIR("A",1)="The directory above could not be found."
SET DIR("A",2)=""
+10 SET DIR("A")="Would you like to create it now"
SET DIR(0)="Y"
SET DIR("B")="N"
+11 DO ^DIR
IF $GET(DTOUT)!$GET(DUOUT)!'Y
SET X=UNXLD
WRITE !
QUIT
+12 SET X=UNXLD
+13 DO MAKEDIR^PSNFTP2(UNXLD)
SET NDIR=1
WRITE !
+14 IF '$$DIREXIST^PSNFTP2(UNXLD)
Begin DoDot:2
+15 WRITE !!,"Warning: "_$SELECT($GET(NDIR):"The directory could not be created.",1:"The directory could not be found and is required for PPSN update file download."),!,$CHAR(7)
+16 KILL DIR
SET DIR(0)="FOA"
SET DIR("A")=" Press <RET> to continue, or '^' to quit "
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PSNOUT=1
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
LXDIR() ; -- Returns the Linux Directory for PPSN sFTP
+1 ;*573 Added condition check for IRIS
+2 NEW CURDIR,ROOTDIR,PSNVER
+3 SET PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
+4 IF $$OS^%ZOSV()'="UNIX"
QUIT ""
+5 IF PSNVER'["CACHE"
IF PSNVER'["IRIS"
QUIT ""
+6 ; Retrieving the current directory
+7 XECUTE "S CURDIR=$ZU(12)"
SET ROOTDIR=$PIECE(CURDIR,"/",1,4)
+8 IF $EXTRACT(ROOTDIR,$LENGTH(ROOTDIR))="/"
SET $EXTRACT(ROOTDIR,$LENGTH(ROOTDIR))=""
+9 QUIT ROOTDIR_"/user/sftp/PPSN/"
+10 ;
SCR(Y) ; -- screen entry to the Legacy Update Processing field
+1 NEW TYPE,OK
+2 SET TYPE=$PIECE(^PS(59.7,1,10),"^",12)
SET OK=1
+3 IF "QN"[TYPE
IF Y="Y"
SET OK=0
+4 QUIT OK
+5 ;
STRIP(X) ; strip control chrs and any other invalid characters
+1 NEW II,YY,CHR
+2 ; remove control characters & special chars
+3 SET YY=""
FOR II=1:1:$LENGTH(X)
IF $ASCII(X,II)>31
SET YY=YY_$EXTRACT(X,II)
+4 SET CHR="!#%&*)({} "
FOR II=1:1:$LENGTH(CHR)
IF YY[$EXTRACT(CHR,II)
SET YY=$$STRIP^XLFSTR(YY,$EXTRACT(CHR,II))
+5 QUIT YY
+6 ;
FIELD ; -- field name
+1 ;;1^PPS-N Install Version
+2 ;;2^PPS-N Download Version
+3 ;;3^Open VMS Local Directory
+4 ;;4^Unix/Linux Local Directory
+5 ;;5^Remote Server Address
+6 ;;6^Remote Server Directory
+7 ;;7^Remote SFTP Username
+8 ;;8^Primary PPS-N Mail Group
+9 ;;9^Secondary PPS-N Mail group
+10 ;;10^PPS-N Account Type
+11 ;;11^Legacy Update Processing
+12 ;;12^Download Status
+13 ;;13^Install Status
+14 ;;14^Disable Menus, Options, etc
+15 ;;END
