- PSNPARM ;BIR/SJA-PPS-N Site Parameters ; 11/16/2016
- ;;4.0;NATIONAL DRUG FILE;**513,573,575**; 30 Oct 98;Build 22
- ;
- ;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^15^"
- 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:15"
- I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>15)!(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
- S PSNAR(15)=$S($P(NODE0,"^",11)=1:"ALLOWED",1:"NOT ALLOWED")_"^57.23^11"
- 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
- ;;15^ECDSA keys
- ;;END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNPARM 8078 printed Jan 18, 2025@03:25:31 Page 2
- PSNPARM ;BIR/SJA-PPS-N Site Parameters ; 11/16/2016
- +1 ;;4.0;NATIONAL DRUG FILE;**513,573,575**; 30 Oct 98;Build 22
- +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^15^"
- +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:15"
- +5 IF X?.N1":".N
- SET Y=$EXTRACT(X)
- SET Z=$PIECE(X,":",2)
- IF Y<1!(Z>15)!(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 SET PSNAR(15)=$SELECT($PIECE(NODE0,"^",11)=1:"ALLOWED",1:"NOT ALLOWED")_"^57.23^11"
- +15 FOR PSNJ=1:1
- if '$DATA(PSNZ(PSNJ))
- QUIT
- WRITE !,$$RJ^XLFSTR((PSNJ_"."),3," ")," ",$SELECT(REQFLDS[("^"_PSNJ_"^"):"*",1:" "),PSNZ(PSNJ),?33,": ",$PIECE(PSNAR(PSNJ),"^")
- +16 WRITE !,LN
- +17 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 ;;15^ECDSA keys
- +16 ;;END