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

PSNPARM.m

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