PSOSPMSP ;BIRM/MFR - State Prescription Monitoring Program - State Parameters ;09/04/12
;;7.0;OUTPATIENT PHARMACY;**408,451,625,630,696,724**;DEC 1997;Build 3
;
EN ; - Menu option entry point
N PSOASVER,PSOINCNV,PSOREPFQ,PSOVMSLD,PSOUNXLD,PSOPFIX,PSOEXT,PSOFTPIP,PSOTXRTS,Y
N PSOFTPUS,PSOFTPPN,PSOFTPDR,PSOTXMOD,PSOQUIT,DIC,DIR,DIRUT,DTOUT,DUOUT,LST,DELDIR
N PSOZRVER,Z,PSOSNDPR,PSOZRDIV
;
D FULL^VALM1 W !
;
W ! K DIC S DIC("A")="Select STATE: ",DIC="^DIC(5,",DIC(0)="QOEAM"
I $O(^PS(58.41,0)) S DIC("B")=$O(^PS(58.41,0))
K STATEIEN D ^DIC I X=""!(X="^")!$D(DUOUT)!$D(DTOUT) G END
K DIC("A") G:Y<0 EN S STATEIEN=+Y
;
D DISPLAY(STATEIEN)
;
; Checking the Security Key PSO SPMP ADMIN for Editing the Parameters
I '$D(^XUSEC("PSO SPMP ADMIN",DUZ)) D G EN
. W !,"The security key PSO SPMP ADMIN is required for editing the Parameters." W $C(7)
;
D LOAD(STATEIEN) S PSOQUIT=0
;
ASAPVER ; - ASAP Version
S X=$$ASAPVER^PSOSPMU2("A","R",0,PSOASVER,1,1) I X="^" G EXIT ;Zero Report adding "R"
I X["^"!(X="@") G @$$GOTO(X,"ASAPVER")
S PSOASVER=X D CHANGED(STATEIEN,"ASAPVER",PSOASVER)
;
TRXRTS ; - Auto Transmit Returns (ASAP 1995 only)
I PSOASVER'="1995" S PSOTXRTS="" G ZEROVER ;Zero Report changed from 'G INCNVET' to 'G ZEROVER'
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,12" S:$G(PSOTXRTS)'="" DIR("B")=$S(PSOTXRTS:"YES",1:"NO")
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"TRXRTS")
S PSOTXRTS=Y D CHANGED(STATEIEN,"TRXRTS",PSOTXRTS)
;
ZEROVER ; - Zero Report ASAP Version
S X=$$ASAPVER^PSOSPMU2("A","Z",0,PSOZRVER,0,1) I X="^" G EXIT
I X["^"!(X="@") G @$$GOTO(X,"ZEROVER")
S PSOZRVER=X D CHANGED(STATEIEN,"ZEROVER",PSOZRVER)
;
INCNVET ; Include Non-Veteran Patients
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,2" S DIR("B")=$S(+$G(PSOINCNV):"YES",1:"NO")
D ^DIR I $D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"INCNVET")
S PSOINCNV=Y D CHANGED(STATEIEN,"INCNVET",PSOINCNV)
;
REPFRQ ; Reporting Frequency
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,3" S:$G(PSOREPFQ) DIR("B")=PSOREPFQ
D ^DIR I $D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"REPFRQ")
I Y'?1.2N W !,"Invalid Frequency"
S PSOREPFQ=Y D CHANGED(STATEIEN,"REPFRQ",PSOREPFQ)
;
VMSLDIR ; - Open VMS Local Directory
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,4" S:$G(PSOVMSLD)'="" DIR("B")=PSOVMSLD
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"VMSLDIR")
S PSOVMSLD=Y D CHANGED(STATEIEN,"VMSLDIR",PSOVMSLD)
;
UNXLDIR ; - Unix/Linux Local Directory
K DIR,DIRUT,DTOUT,NEWDIR,PSOVER
I '$G(DELDIR),$G(PSOUNXLD)="" S PSOUNXLD=$$LINUXDIR^PSOSPMU1()
S DIR(0)="58.41,15" S:$G(PSOUNXLD)'="" DIR("B")=PSOUNXLD
S DELDIR=0 D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) S:X="@" DELDIR=1 G @$$GOTO(X,"UNXLDIR")
I $G(Y)'="",$E(Y,$L(X))'="/" S Y=Y_"/"
S PSOUNXLD=Y D CHANGED(STATEIEN,"UNXLDIR",PSOUNXLD)
;
S PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
I PSOUNXLD'="",$$OS^%ZOSV()="UNIX",(PSOVER["CACHE")!(PSOVER["IRIS") D ;PSO*7*630
. I '$$DIREXIST^PSOSPMU1(PSOUNXLD) D
. . W ! S DIR("A",1)="The directory above could not be found."
. . S 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 W ! Q
. . D MAKEDIR^PSOSPMU1(PSOUNXLD) S NEWDIR=1 W !
. I '$$DIREXIST^PSOSPMU1(PSOUNXLD) D
. . W !!,"Warning: "_$S($G(NEWDIR):"The directory could not be created.",1:"The directory could not be found."),!,$C(7)
;
FILEPFIX ; - File name Prefix
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,5" K DIR("B") S:$G(PSOPFIX)'="" DIR("B")=PSOPFIX
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"FILEPFIX")
I Y[" " W ?40,"No spaces allowed.",$C(7) G FILEPFIX
S PSOPFIX=Y D CHANGED(STATEIEN,"FILEPFIX",PSOPFIX)
;
FILEEXT ; File Extension
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,6" S:$G(PSOEXT)'="" DIR("B")=PSOEXT
D ^DIR I $D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"FILEEXT")
S PSOEXT=Y D CHANGED(STATEIEN,"FILEEXT",PSOEXT)
;
RENAME ; Rename File after upload?
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,17" S:$G(PSORENAM)'="" DIR("B")=$S(PSORENAM:"YES",1:"NO")
D ^DIR I $D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"RENAME")
S PSORENAM=Y D CHANGED(STATEIEN,"RENAME",PSORENAM)
;
FTPIP ; - State Server FTP IP Address
K DIR,DIRUT,DTOUT,PV
S DIR(0)="58.41,7" S:$G(PSOFTPIP)'="" DIR("B")=PSOFTPIP
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"FTPIP")
S PSOFTPIP=Y D CHANGED(STATEIEN,"FTPIP",PSOFTPIP)
;
FTPUSER ; - State Server FTP Username
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,8" S:$G(PSOFTPUS)'="" DIR("B")=PSOFTPUS
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"FTPUSER")
S PSOFTPUS=Y D CHANGED(STATEIEN,"FTPUSER",PSOFTPUS)
;
FTPPORT ; - State Server FTP Password
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,9" S:$G(PSOFTPPN)'="" DIR("B")=PSOFTPPN
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"FTPPORT")
S PSOFTPPN=Y D CHANGED(STATEIEN,"FTPPORT",PSOFTPPN)
;
FTPDIR ; - State Server FTP Remote Directory
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,10" S:$G(PSOFTPDR)'="" DIR("B")=PSOFTPDR
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"FTPDIR")
S PSOFTPDR=Y D CHANGED(STATEIEN,"FTPDIR",PSOFTPDR)
;
TRXMODE ; - Transmission Mode (A - Automatic / M - Manual)
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,13",DIR("B")=PSOTXMOD
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"TRXMODE")
S PSOTXMOD=Y D CHANGED(STATEIEN,"TRXMODE",PSOTXMOD)
;
SNDPRMT ; - Send Export State Parameter
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,21",DIR("B")=PSOSNDPR
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"SNDPRMT")
S PSOSNDPR=Y D CHANGED(STATEIEN,"SNDPRMT",PSOSNDPR)
I PSOSNDPR>0 D
. W !,"NOTE: You have selected a parameter that includes sending to state of patient"
. W !,"delivery. Only states that have been setup in your SPMP state parameters"
. W !,"will receive data. Enter a help desk ticket if you have questions"
. W !,"or need assistance.",!
. K DIR S DIR("A")="Enter <RETURN> to continue.",DIR(0)="FO",DIR("T")=DTIME D ^DIR
;
ZERODIV ; - Zero Report MbM default division P696
;Display this parameter only if Send Export State Parameter = 2
I $$GET1^DIQ(58.41,STATEIEN,21,"I")'=2 G EXIT
K DIR,DIRUT,DTOUT
S DIR(0)="58.41,22" S:$G(PSOZRDIV)'="" DIR("B")=PSOZRDIV ;P724
D ^DIR I X'="",$D(DIRUT)!$D(DTOUT) G @$$GOTO(X,"ZERODIV")
S PSOZRDIV=Y D CHANGED(STATEIEN,"ZERODIV",PSOZRDIV)
;
EXIT ; Exit
;
END S VALMBCK="R" Q
;
DISPLAY(STATE) ; - Displays the current Parameters
N ZNODE,FNODE,F1NODE,X
N ONENODE ;Zero Report node
S ZNODE=$G(^PS(58.41,STATE,0)),FNODE=$G(^PS(58.41,STATE,"FILE")),F1NODE=$G(^PS(58.41,STATE,"FILE1"))
S ONENODE=$G(^PS(58.41,STATE,1))
W ! I ZNODE="" Q
W !?5,"ASAP VERSION : ",$P(ZNODE,"^",2)
I $P(ZNODE,"^",2)="1995" D
. W !?5,"TRANSMIT RETURN TO STOCK : ",$S($P(ZNODE,"^",5):"YES",1:"NO")
W !?5,"ZERO REPORT ASAP VERSION : ",$P(ONENODE,"^",1)
W !?5,"INCLUDE NON-VETERAN PATIENTS: ",$S($P(ZNODE,"^",3):"YES",1:"NO")
W !?5,"REPORTING FREQUENCY IN DAYS : ",$P(ZNODE,"^",4)
W !?5,"OPEN VMS LOCAL DIRECTORY : ",$P(FNODE,"^",1)
W !?5,"UNIX/LINUX LOCAL DIRECTORY : ",$P(F1NODE,"^",1)
W !?5,"FILE NAME PREFIX : ",$P(FNODE,"^",2)
W !?5,"FILE EXTENSION : ",$P(FNODE,"^",3)
W !?5,"RENAME FILE AFTER UPLOAD : ",$S($P(ZNODE,"^",7):"YES",1:"NO")
W !?5,"STATE SFTP SERVER IP ADDRESS: ",$P(FNODE,"^",4)
W !?5,"STATE SFTP SERVER USERNAME : ",$P(FNODE,"^",5)
W !?5,"STATE SFTP SERVER PORT # : ",$P(FNODE,"^",6)
W !?5,"STATE SFTP SERVER DIRECTORY : ",$P(FNODE,"^",7)
W !?5,"SFTP TRANSMISSION MODE : ",$$GET1^DIQ(58.41,STATE,13)
W !?5,"SEND EXPORT STATE PARAMETER : ",$$GET1^DIQ(58.41,STATE,21)
I $$GET1^DIQ(58.41,STATE,21,"I")=2 W !?5,"ZERO REPORT DEFAULT DIVISION: ",$$GET1^DIQ(59,$P(ONENODE,"^",2),.06)
W !
Q
;
GOTO(INPUT,HOME) ; - Directed up-arrow
; Input: INPUT - User input (e.g., "@", "^STATE", etc...)
; HOME - Prompt where the user typed the input
;Output: $$GOTO - GoTo Prompt
N GOTO,I,TAG,TRGT,OK2DEL
I INPUT="@",HOME="ASAPVER",$D(^PS(58.41,STATEIEN)) D Q GOTO
. W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="DELETE SPMP STATE PARAMETERS FOR "_$$GET1^DIQ(5,STATEIEN,.01)
. D ^DIR I $D(DIRUT)!$D(DTOUT)!(Y=0) S GOTO=HOME W ! Q
. N DIK,DA S DIK="^PS(58.41,",DA=STATEIEN D ^DIK S GOTO="EN"
;
S OK2DEL="TRXRTS^FTPDIR^FILEPFIX^VMSLDIR^UNXLDIR^WINLDIR^FTPPORT^ZEROVER^ZERODIV"
I INPUT="@",OK2DEL'[HOME D Q HOME
. W " Cannot delete field",$C(7)
I INPUT="@" D Q HOME
. S:HOME="FTPDIR" PSOFTPDR="" S:HOME="FILEPFIX" PSOPFIX=""
. S:HOME="VMSLDIR" PSOVMSLD="" S:HOME="UNXLDIR" PSOUNXLD=""
. S:HOME="FTPPORT" PSOFTPPN="" S:HOME="ZEROVER" PSOZRVER=""
. S:HOME="ZERODIV" PSOZRDIV=""
. D SAVE(STATEIEN,HOME,"")
;
I $P(INPUT,"^",2)="" S PSOQUIT=1 Q "EXIT"
;
S TRGT=$$UP^XLFSTR($P(INPUT,"^",2))
S TAG(1)="ASAP VERSION^ASAPVER"
S:PSOASVER="1995" TAG(2)="TRANSMIT RETURN TO STOCK^TRXRTS"
S TAG(3)="ZERO REPORT ASAP VERSION^ZEROVER" ;adding Zero Report Version and renumber
S TAG(4)="INCLUDE NON-VETERAN PATIENTS^INCNVET"
S TAG(5)="REPORTING FREQUENCY IN DAYS^REPFRQ"
S TAG(6)="OPEN VMS LOCAL DIRECTORY^VMSLDIR"
S TAG(7)="UNIX/LINUX LOCAL DIRECTORY^UNXLDIR"
S TAG(8)="FILE NAME PREFIX^FILEPFIX"
S TAG(9)="FILE EXTENSION^FILEEXT"
S TAG(10)="RENAME FILE AFTER UPLOAD^RENAME"
S TAG(11)="STATE SFTP SERVER IP ADDRESS^FTPIP"
S TAG(12)="STATE SFTP SERVER USERNAME^FTPUSER"
S TAG(13)="STATE SFTP SERVER PORT #^FTPPORT"
S TAG(14)="STATE SFTP SERVER DIRECTORY^FTPDIR"
S TAG(15)="SFTP TRANSMISSION MODE^TRXMODE"
S TAG(16)="SEND EXPORT STATE PARAMETER^SNDPRMT"
S:$$GET1^DIQ(58.41,STATE,21,"I")=2 TAG(17)="ZERO REPORT DEFAULT DIVISION^"_$$GET1^DIQ(59,ZERODIV,.06)
;
S GOTO=HOME,I=""
F S I=$O(TAG(I)) Q:'I S TAG=TAG(I) I $E($P(TAG,"^"),1,$L(TRGT))=TRGT S GOTO=$P(TAG,"^",2) Q
;
Q GOTO
;
LOAD(STATE) ; Loading Factory/Division/User preferences
;Input : STATE - Pointer to STATE file (#5)
;Output: PSOASVER - ASAP Version
; PSOTXRTS - Transmit Return To Stock fills
; PSOINCNV - Exclude Non-Veteran Patients
; PSOREPFQ - Reporting Frequency
; PSOVMSLD - Open VMS Local Directory
; PSOUNXLD - Unix/Linux Local Directory
; PSOPFIX - File Name Prefix
; PSOEXT - File Extension (.TXT or .DAT)
; PSORENAM - Rename File After Upload
; PSOZRVER - Send Zero Report
; PSOFTPIP - State Server FTP IP Address
; PSOFTPUS - State Server FTP Username
; PSOFTPPN - State Server FTP Password
; PSOFTPDR - State Server FTP Directory
; PSOTXMOD - Transmission Mode ('A' or 'M')
; PSOSNDPR - Send Export State Parameter
; PSOZRDIV - Zero Reporting Meds by Mail Division
K PSOASVER,PSOINCNV,PSOREPFQ,PSOVMSLD,PSOUNXLD,PSOWINLD,PSOPFIX,PSOEXT,PSORENAM,PSOFTPIP,PSOFTPUS
K PSOFTPPN,PSOFTPDR
K PSOZRVER,PSOZRDIV
;
N X,ZNODE,FNODE,F1NODE,LINE,ONENODE
;
; - Defaults
S PSOASVER="4.2"
S PSOTXRTS="0"
S PSOINCNV=0
S PSOREPFQ="1"
S PSOVMSLD=""
S PSOUNXLD=""
S PSOPFIX=""
S PSOEXT=".DAT"
S PSORENAM="YES"
S PSOZRVER=""
S PSOZRDIV=""
S PSOFTPIP=""
S PSOFTPUS=""
S PSOFTPPN=""
S PSOFTPDR=""
S PSOTXMOD="A"
S PSOSNDPR="0"
;
; - State's parameters
I $D(^PS(58.41,STATE,0)) D
. S ZNODE=$G(^PS(58.41,STATE,0)) I $P(ZNODE,"^",1)'=STATE Q
. S FNODE=$G(^PS(58.41,STATE,"FILE")),F1NODE=$G(^PS(58.41,STATE,"FILE1"))
. S ONENODE=$G(^PS(58.41,STATE,1)) ;Zero Report node
. S:$P(ZNODE,"^",2)'="" PSOASVER=$P(ZNODE,"^",2)
. S:$P(ZNODE,"^",3)'="" PSOINCNV=$P(ZNODE,"^",3)
. S:$P(ONENODE,"^",1)'="" PSOZRVER=$P(ONENODE,"^",1)
. S:$P(ONENODE,"^",2)'="" PSOZRDIV=$$GET1^DIQ(59,$P(ONENODE,"^",2),.06)
. S:$P(ZNODE,"^",4)'="" PSOREPFQ=$P(ZNODE,"^",4)
. S:$P(ZNODE,"^",5)'="" PSOTXRTS=$P(ZNODE,"^",5)
. S:$P(ZNODE,"^",6)'="" PSOTXMOD=$P(ZNODE,"^",6)
. S:$P(ZNODE,"^",7)'="" PSORENAM=$P(ZNODE,"^",7)
. S:$P(ZNODE,"^",8)'="" PSOSNDPR=$P(ZNODE,"^",8)
. S:$P(FNODE,"^",1)'="" PSOVMSLD=$P(FNODE,"^",1)
. S:$P(FNODE,"^",2)'="" PSOPFIX=$P(FNODE,"^",2)
. S:$P(FNODE,"^",3)'="" PSOEXT=$P(FNODE,"^",3)
. S:$P(FNODE,"^",4)'="" PSOFTPIP=$P(FNODE,"^",4)
. S:$P(FNODE,"^",5)'="" PSOFTPUS=$P(FNODE,"^",5)
. S:$P(FNODE,"^",6)'="" PSOFTPPN=$P(FNODE,"^",6)
. S:$P(FNODE,"^",7)'="" PSOFTPDR=$P(FNODE,"^",7)
. S:$P(F1NODE,"^",1)'="" PSOUNXLD=$P(F1NODE,"^",1)
Q
;
CHANGED(STATE,FIELD,VALUE) ; - If field was change Automatically Invokes SAVE
;Input : STATE - Pointer to STATE file (#5)
; FIELD - Field ID (Internal)
; VALUE - Field Value
N CHANGED,ZNODE,FNODE,F1NODE,LINE
;
S CHANGED=0
; - Saved Division's parameters
S ZNODE=$G(^PS(58.41,STATE,0)),FNODE=$G(^PS(58.41,STATE,"FILE")),F1NODE=$G(^PS(58.41,STATE,"FILE1"))
S ONENODE=$G(^PS(58.41,STATE,1)) ;Zero Report node
;
I FIELD="ASAPVER",VALUE'=$P(ZNODE,"^",2) S CHANGED=1
I FIELD="TRXRTS",VALUE'=$P(ZNODE,"^",5) S CHANGED=1
I FIELD="ZEROVER",VALUE'=$P(ONENODE,"^",1) S CHANGED=1
I FIELD="ZERODIV",VALUE'=$P(ONENODE,"^",2) S CHANGED=1
I FIELD="INCNVET",VALUE'=$P(ZNODE,"^",3) S CHANGED=1
I FIELD="VMSLDIR",VALUE'=$P(FNODE,"^",1) S CHANGED=1
I FIELD="UNXLDIR",VALUE'=$P(F1NODE,"^",1) S CHANGED=1
I FIELD="WINLDIR",VALUE'=$P(F1NODE,"^",2) S CHANGED=1
I FIELD="REPFRQ",VALUE'=$P(ZNODE,"^",4) S CHANGED=1
I FIELD="FILEPFIX",VALUE'=$P(FNODE,"^",2) S CHANGED=1
I FIELD="FILEEXT",VALUE'=$P(FNODE,"^",3) S CHANGED=1
I FIELD="RENAME",VALUE'=$P(ZNODE,"^",7) S CHANGED=1
I FIELD="FTPIP",VALUE'=$P(FNODE,"^",4) S CHANGED=1
I FIELD="FTPUSER",VALUE'=$P(FNODE,"^",5) S CHANGED=1
I FIELD="FTPPORT",VALUE'=$P(FNODE,"^",6) S CHANGED=1
I FIELD="FTPDIR",VALUE'=$P(FNODE,"^",7) S CHANGED=1
I FIELD="TRXMODE",VALUE'=$P(ZNODE,"^",6) S CHANGED=1
I FIELD="SNDPRMT",VALUE'=$P(ZNODE,"^",8) S CHANGED=1
;
I CHANGED D SAVE(STATE,FIELD,$G(VALUE))
Q
;
SAVE(STATE,FIELD,VALUE) ; - Saves preferences by State
;Input : STATE - Pointer to STATE file (#5)
; FIELD - Field ID (Internal)
; VALUE - Field Value
N DIE,DR,DA,LINE
;
I '$D(^PS(58.41,STATE)) D
. N %,DIC,DR,DA,X,DINUM,DLAYGO,DD,DO
. S DIC="^PS(58.41,",(DINUM,X)=STATE,DIC(0)=""
. K DD,DO D FILE^DICN K DD,DO
;
I FIELD="ASAPVER" S DR="1///"_PSOASVER
I FIELD="TRXRTS" S DR="12////"_PSOTXRTS
I FIELD="ZEROVER" S DR="20///"_$S(PSOZRVER="":"@",1:PSOZRVER)
I FIELD="ZERODIV" S DR="22////"_$S(PSOZRDIV="":"@",1:PSOZRDIV)
I FIELD="INCNVET" S DR="2///"_PSOINCNV
I FIELD="VMSLDIR" S DR="4////"_$S(PSOVMSLD="":"@",1:PSOVMSLD)
I FIELD="UNXLDIR" S DR="15////"_$S(PSOUNXLD="":"@",1:PSOUNXLD)
I FIELD="REPFRQ" S DR="3///"_PSOREPFQ
I FIELD="FILEPFIX" S DR="5////"_$S(PSOPFIX="":"@",1:PSOPFIX)
I FIELD="FILEEXT" S DR="6///"_PSOEXT
I FIELD="RENAME" S DR="17///"_PSORENAM
I FIELD="FTPIP" S DR="7///"_PSOFTPIP
I FIELD="FTPUSER" S DR="8///"_PSOFTPUS
I FIELD="FTPPORT" S DR="9////"_$S(PSOFTPPN="":"@",1:PSOFTPPN)
I FIELD="FTPDIR" S DR="10////"_$S(PSOFTPDR="":"@",1:PSOFTPDR)
I FIELD="TRXMODE" S DR="13////"_PSOTXMOD
I FIELD="SNDPRMT" S DR="21////"_PSOSNDPR
S DIE="^PS(58.41,",DA=STATE D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMSP 15126 printed Sep 23, 2025@20:11:36 Page 2
PSOSPMSP ;BIRM/MFR - State Prescription Monitoring Program - State Parameters ;09/04/12
+1 ;;7.0;OUTPATIENT PHARMACY;**408,451,625,630,696,724**;DEC 1997;Build 3
+2 ;
EN ; - Menu option entry point
+1 NEW PSOASVER,PSOINCNV,PSOREPFQ,PSOVMSLD,PSOUNXLD,PSOPFIX,PSOEXT,PSOFTPIP,PSOTXRTS,Y
+2 NEW PSOFTPUS,PSOFTPPN,PSOFTPDR,PSOTXMOD,PSOQUIT,DIC,DIR,DIRUT,DTOUT,DUOUT,LST,DELDIR
+3 NEW PSOZRVER,Z,PSOSNDPR,PSOZRDIV
+4 ;
+5 DO FULL^VALM1
WRITE !
+6 ;
+7 WRITE !
KILL DIC
SET DIC("A")="Select STATE: "
SET DIC="^DIC(5,"
SET DIC(0)="QOEAM"
+8 IF $ORDER(^PS(58.41,0))
SET DIC("B")=$ORDER(^PS(58.41,0))
+9 KILL STATEIEN
DO ^DIC
IF X=""!(X="^")!$DATA(DUOUT)!$DATA(DTOUT)
GOTO END
+10 KILL DIC("A")
if Y<0
GOTO EN
SET STATEIEN=+Y
+11 ;
+12 DO DISPLAY(STATEIEN)
+13 ;
+14 ; Checking the Security Key PSO SPMP ADMIN for Editing the Parameters
+15 IF '$DATA(^XUSEC("PSO SPMP ADMIN",DUZ))
Begin DoDot:1
+16 WRITE !,"The security key PSO SPMP ADMIN is required for editing the Parameters."
WRITE $CHAR(7)
End DoDot:1
GOTO EN
+17 ;
+18 DO LOAD(STATEIEN)
SET PSOQUIT=0
+19 ;
ASAPVER ; - ASAP Version
+1 ;Zero Report adding "R"
SET X=$$ASAPVER^PSOSPMU2("A","R",0,PSOASVER,1,1)
IF X="^"
GOTO EXIT
+2 IF X["^"!(X="@")
GOTO @$$GOTO(X,"ASAPVER")
+3 SET PSOASVER=X
DO CHANGED(STATEIEN,"ASAPVER",PSOASVER)
+4 ;
TRXRTS ; - Auto Transmit Returns (ASAP 1995 only)
+1 ;Zero Report changed from 'G INCNVET' to 'G ZEROVER'
IF PSOASVER'="1995"
SET PSOTXRTS=""
GOTO ZEROVER
+2 KILL DIR,DIRUT,DTOUT
+3 SET DIR(0)="58.41,12"
if $GET(PSOTXRTS)'=""
SET DIR("B")=$SELECT(PSOTXRTS:"YES",1:"NO")
+4 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"TRXRTS")
+5 SET PSOTXRTS=Y
DO CHANGED(STATEIEN,"TRXRTS",PSOTXRTS)
+6 ;
ZEROVER ; - Zero Report ASAP Version
+1 SET X=$$ASAPVER^PSOSPMU2("A","Z",0,PSOZRVER,0,1)
IF X="^"
GOTO EXIT
+2 IF X["^"!(X="@")
GOTO @$$GOTO(X,"ZEROVER")
+3 SET PSOZRVER=X
DO CHANGED(STATEIEN,"ZEROVER",PSOZRVER)
+4 ;
INCNVET ; Include Non-Veteran Patients
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,2"
SET DIR("B")=$SELECT(+$GET(PSOINCNV):"YES",1:"NO")
+3 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"INCNVET")
+4 SET PSOINCNV=Y
DO CHANGED(STATEIEN,"INCNVET",PSOINCNV)
+5 ;
REPFRQ ; Reporting Frequency
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,3"
if $GET(PSOREPFQ)
SET DIR("B")=PSOREPFQ
+3 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"REPFRQ")
+4 IF Y'?1.2N
WRITE !,"Invalid Frequency"
+5 SET PSOREPFQ=Y
DO CHANGED(STATEIEN,"REPFRQ",PSOREPFQ)
+6 ;
VMSLDIR ; - Open VMS Local Directory
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,4"
if $GET(PSOVMSLD)'=""
SET DIR("B")=PSOVMSLD
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"VMSLDIR")
+4 SET PSOVMSLD=Y
DO CHANGED(STATEIEN,"VMSLDIR",PSOVMSLD)
+5 ;
UNXLDIR ; - Unix/Linux Local Directory
+1 KILL DIR,DIRUT,DTOUT,NEWDIR,PSOVER
+2 IF '$GET(DELDIR)
IF $GET(PSOUNXLD)=""
SET PSOUNXLD=$$LINUXDIR^PSOSPMU1()
+3 SET DIR(0)="58.41,15"
if $GET(PSOUNXLD)'=""
SET DIR("B")=PSOUNXLD
+4 SET DELDIR=0
DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
if X="@"
SET DELDIR=1
GOTO @$$GOTO(X,"UNXLDIR")
+5 IF $GET(Y)'=""
IF $EXTRACT(Y,$LENGTH(X))'="/"
SET Y=Y_"/"
+6 SET PSOUNXLD=Y
DO CHANGED(STATEIEN,"UNXLDIR",PSOUNXLD)
+7 ;
+8 SET PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
+9 ;PSO*7*630
IF PSOUNXLD'=""
IF $$OS^%ZOSV()="UNIX"
IF (PSOVER["CACHE")!(PSOVER["IRIS")
Begin DoDot:1
+10 IF '$$DIREXIST^PSOSPMU1(PSOUNXLD)
Begin DoDot:2
+11 WRITE !
SET DIR("A",1)="The directory above could not be found."
+12 SET DIR("A",2)=""
+13 SET DIR("A")="Would you like to create it now"
SET DIR(0)="Y"
SET DIR("B")="N"
+14 DO ^DIR
IF $GET(DTOUT)!$GET(DUOUT)!'Y
WRITE !
QUIT
+15 DO MAKEDIR^PSOSPMU1(PSOUNXLD)
SET NEWDIR=1
WRITE !
End DoDot:2
+16 IF '$$DIREXIST^PSOSPMU1(PSOUNXLD)
Begin DoDot:2
+17 WRITE !!,"Warning: "_$SELECT($GET(NEWDIR):"The directory could not be created.",1:"The directory could not be found."),!,$CHAR(7)
End DoDot:2
End DoDot:1
+18 ;
FILEPFIX ; - File name Prefix
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,5"
KILL DIR("B")
if $GET(PSOPFIX)'=""
SET DIR("B")=PSOPFIX
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"FILEPFIX")
+4 IF Y[" "
WRITE ?40,"No spaces allowed.",$CHAR(7)
GOTO FILEPFIX
+5 SET PSOPFIX=Y
DO CHANGED(STATEIEN,"FILEPFIX",PSOPFIX)
+6 ;
FILEEXT ; File Extension
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,6"
if $GET(PSOEXT)'=""
SET DIR("B")=PSOEXT
+3 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"FILEEXT")
+4 SET PSOEXT=Y
DO CHANGED(STATEIEN,"FILEEXT",PSOEXT)
+5 ;
RENAME ; Rename File after upload?
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,17"
if $GET(PSORENAM)'=""
SET DIR("B")=$SELECT(PSORENAM:"YES",1:"NO")
+3 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"RENAME")
+4 SET PSORENAM=Y
DO CHANGED(STATEIEN,"RENAME",PSORENAM)
+5 ;
FTPIP ; - State Server FTP IP Address
+1 KILL DIR,DIRUT,DTOUT,PV
+2 SET DIR(0)="58.41,7"
if $GET(PSOFTPIP)'=""
SET DIR("B")=PSOFTPIP
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"FTPIP")
+4 SET PSOFTPIP=Y
DO CHANGED(STATEIEN,"FTPIP",PSOFTPIP)
+5 ;
FTPUSER ; - State Server FTP Username
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,8"
if $GET(PSOFTPUS)'=""
SET DIR("B")=PSOFTPUS
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"FTPUSER")
+4 SET PSOFTPUS=Y
DO CHANGED(STATEIEN,"FTPUSER",PSOFTPUS)
+5 ;
FTPPORT ; - State Server FTP Password
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,9"
if $GET(PSOFTPPN)'=""
SET DIR("B")=PSOFTPPN
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"FTPPORT")
+4 SET PSOFTPPN=Y
DO CHANGED(STATEIEN,"FTPPORT",PSOFTPPN)
+5 ;
FTPDIR ; - State Server FTP Remote Directory
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,10"
if $GET(PSOFTPDR)'=""
SET DIR("B")=PSOFTPDR
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"FTPDIR")
+4 SET PSOFTPDR=Y
DO CHANGED(STATEIEN,"FTPDIR",PSOFTPDR)
+5 ;
TRXMODE ; - Transmission Mode (A - Automatic / M - Manual)
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,13"
SET DIR("B")=PSOTXMOD
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"TRXMODE")
+4 SET PSOTXMOD=Y
DO CHANGED(STATEIEN,"TRXMODE",PSOTXMOD)
+5 ;
SNDPRMT ; - Send Export State Parameter
+1 KILL DIR,DIRUT,DTOUT
+2 SET DIR(0)="58.41,21"
SET DIR("B")=PSOSNDPR
+3 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"SNDPRMT")
+4 SET PSOSNDPR=Y
DO CHANGED(STATEIEN,"SNDPRMT",PSOSNDPR)
+5 IF PSOSNDPR>0
Begin DoDot:1
+6 WRITE !,"NOTE: You have selected a parameter that includes sending to state of patient"
+7 WRITE !,"delivery. Only states that have been setup in your SPMP state parameters"
+8 WRITE !,"will receive data. Enter a help desk ticket if you have questions"
+9 WRITE !,"or need assistance.",!
+10 KILL DIR
SET DIR("A")="Enter <RETURN> to continue."
SET DIR(0)="FO"
SET DIR("T")=DTIME
DO ^DIR
End DoDot:1
+11 ;
ZERODIV ; - Zero Report MbM default division P696
+1 ;Display this parameter only if Send Export State Parameter = 2
+2 IF $$GET1^DIQ(58.41,STATEIEN,21,"I")'=2
GOTO EXIT
+3 KILL DIR,DIRUT,DTOUT
+4 ;P724
SET DIR(0)="58.41,22"
if $GET(PSOZRDIV)'=""
SET DIR("B")=PSOZRDIV
+5 DO ^DIR
IF X'=""
IF $DATA(DIRUT)!$DATA(DTOUT)
GOTO @$$GOTO(X,"ZERODIV")
+6 SET PSOZRDIV=Y
DO CHANGED(STATEIEN,"ZERODIV",PSOZRDIV)
+7 ;
EXIT ; Exit
+1 ;
END SET VALMBCK="R"
QUIT
+1 ;
DISPLAY(STATE) ; - Displays the current Parameters
+1 NEW ZNODE,FNODE,F1NODE,X
+2 ;Zero Report node
NEW ONENODE
+3 SET ZNODE=$GET(^PS(58.41,STATE,0))
SET FNODE=$GET(^PS(58.41,STATE,"FILE"))
SET F1NODE=$GET(^PS(58.41,STATE,"FILE1"))
+4 SET ONENODE=$GET(^PS(58.41,STATE,1))
+5 WRITE !
IF ZNODE=""
QUIT
+6 WRITE !?5,"ASAP VERSION : ",$PIECE(ZNODE,"^",2)
+7 IF $PIECE(ZNODE,"^",2)="1995"
Begin DoDot:1
+8 WRITE !?5,"TRANSMIT RETURN TO STOCK : ",$SELECT($PIECE(ZNODE,"^",5):"YES",1:"NO")
End DoDot:1
+9 WRITE !?5,"ZERO REPORT ASAP VERSION : ",$PIECE(ONENODE,"^",1)
+10 WRITE !?5,"INCLUDE NON-VETERAN PATIENTS: ",$SELECT($PIECE(ZNODE,"^",3):"YES",1:"NO")
+11 WRITE !?5,"REPORTING FREQUENCY IN DAYS : ",$PIECE(ZNODE,"^",4)
+12 WRITE !?5,"OPEN VMS LOCAL DIRECTORY : ",$PIECE(FNODE,"^",1)
+13 WRITE !?5,"UNIX/LINUX LOCAL DIRECTORY : ",$PIECE(F1NODE,"^",1)
+14 WRITE !?5,"FILE NAME PREFIX : ",$PIECE(FNODE,"^",2)
+15 WRITE !?5,"FILE EXTENSION : ",$PIECE(FNODE,"^",3)
+16 WRITE !?5,"RENAME FILE AFTER UPLOAD : ",$SELECT($PIECE(ZNODE,"^",7):"YES",1:"NO")
+17 WRITE !?5,"STATE SFTP SERVER IP ADDRESS: ",$PIECE(FNODE,"^",4)
+18 WRITE !?5,"STATE SFTP SERVER USERNAME : ",$PIECE(FNODE,"^",5)
+19 WRITE !?5,"STATE SFTP SERVER PORT # : ",$PIECE(FNODE,"^",6)
+20 WRITE !?5,"STATE SFTP SERVER DIRECTORY : ",$PIECE(FNODE,"^",7)
+21 WRITE !?5,"SFTP TRANSMISSION MODE : ",$$GET1^DIQ(58.41,STATE,13)
+22 WRITE !?5,"SEND EXPORT STATE PARAMETER : ",$$GET1^DIQ(58.41,STATE,21)
+23 IF $$GET1^DIQ(58.41,STATE,21,"I")=2
WRITE !?5,"ZERO REPORT DEFAULT DIVISION: ",$$GET1^DIQ(59,$PIECE(ONENODE,"^",2),.06)
+24 WRITE !
+25 QUIT
+26 ;
GOTO(INPUT,HOME) ; - Directed up-arrow
+1 ; Input: INPUT - User input (e.g., "@", "^STATE", etc...)
+2 ; HOME - Prompt where the user typed the input
+3 ;Output: $$GOTO - GoTo Prompt
+4 NEW GOTO,I,TAG,TRGT,OK2DEL
+5 IF INPUT="@"
IF HOME="ASAPVER"
IF $DATA(^PS(58.41,STATEIEN))
Begin DoDot:1
+6 WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="DELETE SPMP STATE PARAMETERS FOR "_$$GET1^DIQ(5,STATEIEN,.01)
+7 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)!(Y=0)
SET GOTO=HOME
WRITE !
QUIT
+8 NEW DIK,DA
SET DIK="^PS(58.41,"
SET DA=STATEIEN
DO ^DIK
SET GOTO="EN"
End DoDot:1
QUIT GOTO
+9 ;
+10 SET OK2DEL="TRXRTS^FTPDIR^FILEPFIX^VMSLDIR^UNXLDIR^WINLDIR^FTPPORT^ZEROVER^ZERODIV"
+11 IF INPUT="@"
IF OK2DEL'[HOME
Begin DoDot:1
+12 WRITE " Cannot delete field",$CHAR(7)
End DoDot:1
QUIT HOME
+13 IF INPUT="@"
Begin DoDot:1
+14 if HOME="FTPDIR"
SET PSOFTPDR=""
if HOME="FILEPFIX"
SET PSOPFIX=""
+15 if HOME="VMSLDIR"
SET PSOVMSLD=""
if HOME="UNXLDIR"
SET PSOUNXLD=""
+16 if HOME="FTPPORT"
SET PSOFTPPN=""
if HOME="ZEROVER"
SET PSOZRVER=""
+17 if HOME="ZERODIV"
SET PSOZRDIV=""
+18 DO SAVE(STATEIEN,HOME,"")
End DoDot:1
QUIT HOME
+19 ;
+20 IF $PIECE(INPUT,"^",2)=""
SET PSOQUIT=1
QUIT "EXIT"
+21 ;
+22 SET TRGT=$$UP^XLFSTR($PIECE(INPUT,"^",2))
+23 SET TAG(1)="ASAP VERSION^ASAPVER"
+24 if PSOASVER="1995"
SET TAG(2)="TRANSMIT RETURN TO STOCK^TRXRTS"
+25 ;adding Zero Report Version and renumber
SET TAG(3)="ZERO REPORT ASAP VERSION^ZEROVER"
+26 SET TAG(4)="INCLUDE NON-VETERAN PATIENTS^INCNVET"
+27 SET TAG(5)="REPORTING FREQUENCY IN DAYS^REPFRQ"
+28 SET TAG(6)="OPEN VMS LOCAL DIRECTORY^VMSLDIR"
+29 SET TAG(7)="UNIX/LINUX LOCAL DIRECTORY^UNXLDIR"
+30 SET TAG(8)="FILE NAME PREFIX^FILEPFIX"
+31 SET TAG(9)="FILE EXTENSION^FILEEXT"
+32 SET TAG(10)="RENAME FILE AFTER UPLOAD^RENAME"
+33 SET TAG(11)="STATE SFTP SERVER IP ADDRESS^FTPIP"
+34 SET TAG(12)="STATE SFTP SERVER USERNAME^FTPUSER"
+35 SET TAG(13)="STATE SFTP SERVER PORT #^FTPPORT"
+36 SET TAG(14)="STATE SFTP SERVER DIRECTORY^FTPDIR"
+37 SET TAG(15)="SFTP TRANSMISSION MODE^TRXMODE"
+38 SET TAG(16)="SEND EXPORT STATE PARAMETER^SNDPRMT"
+39 if $$GET1^DIQ(58.41,STATE,21,"I")=2
SET TAG(17)="ZERO REPORT DEFAULT DIVISION^"_$$GET1^DIQ(59,ZERODIV,.06)
+40 ;
+41 SET GOTO=HOME
SET I=""
+42 FOR
SET I=$ORDER(TAG(I))
if 'I
QUIT
SET TAG=TAG(I)
IF $EXTRACT($PIECE(TAG,"^"),1,$LENGTH(TRGT))=TRGT
SET GOTO=$PIECE(TAG,"^",2)
QUIT
+43 ;
+44 QUIT GOTO
+45 ;
LOAD(STATE) ; Loading Factory/Division/User preferences
+1 ;Input : STATE - Pointer to STATE file (#5)
+2 ;Output: PSOASVER - ASAP Version
+3 ; PSOTXRTS - Transmit Return To Stock fills
+4 ; PSOINCNV - Exclude Non-Veteran Patients
+5 ; PSOREPFQ - Reporting Frequency
+6 ; PSOVMSLD - Open VMS Local Directory
+7 ; PSOUNXLD - Unix/Linux Local Directory
+8 ; PSOPFIX - File Name Prefix
+9 ; PSOEXT - File Extension (.TXT or .DAT)
+10 ; PSORENAM - Rename File After Upload
+11 ; PSOZRVER - Send Zero Report
+12 ; PSOFTPIP - State Server FTP IP Address
+13 ; PSOFTPUS - State Server FTP Username
+14 ; PSOFTPPN - State Server FTP Password
+15 ; PSOFTPDR - State Server FTP Directory
+16 ; PSOTXMOD - Transmission Mode ('A' or 'M')
+17 ; PSOSNDPR - Send Export State Parameter
+18 ; PSOZRDIV - Zero Reporting Meds by Mail Division
+19 KILL PSOASVER,PSOINCNV,PSOREPFQ,PSOVMSLD,PSOUNXLD,PSOWINLD,PSOPFIX,PSOEXT,PSORENAM,PSOFTPIP,PSOFTPUS
+20 KILL PSOFTPPN,PSOFTPDR
+21 KILL PSOZRVER,PSOZRDIV
+22 ;
+23 NEW X,ZNODE,FNODE,F1NODE,LINE,ONENODE
+24 ;
+25 ; - Defaults
+26 SET PSOASVER="4.2"
+27 SET PSOTXRTS="0"
+28 SET PSOINCNV=0
+29 SET PSOREPFQ="1"
+30 SET PSOVMSLD=""
+31 SET PSOUNXLD=""
+32 SET PSOPFIX=""
+33 SET PSOEXT=".DAT"
+34 SET PSORENAM="YES"
+35 SET PSOZRVER=""
+36 SET PSOZRDIV=""
+37 SET PSOFTPIP=""
+38 SET PSOFTPUS=""
+39 SET PSOFTPPN=""
+40 SET PSOFTPDR=""
+41 SET PSOTXMOD="A"
+42 SET PSOSNDPR="0"
+43 ;
+44 ; - State's parameters
+45 IF $DATA(^PS(58.41,STATE,0))
Begin DoDot:1
+46 SET ZNODE=$GET(^PS(58.41,STATE,0))
IF $PIECE(ZNODE,"^",1)'=STATE
QUIT
+47 SET FNODE=$GET(^PS(58.41,STATE,"FILE"))
SET F1NODE=$GET(^PS(58.41,STATE,"FILE1"))
+48 ;Zero Report node
SET ONENODE=$GET(^PS(58.41,STATE,1))
+49 if $PIECE(ZNODE,"^",2)'=""
SET PSOASVER=$PIECE(ZNODE,"^",2)
+50 if $PIECE(ZNODE,"^",3)'=""
SET PSOINCNV=$PIECE(ZNODE,"^",3)
+51 if $PIECE(ONENODE,"^",1)'=""
SET PSOZRVER=$PIECE(ONENODE,"^",1)
+52 if $PIECE(ONENODE,"^",2)'=""
SET PSOZRDIV=$$GET1^DIQ(59,$PIECE(ONENODE,"^",2),.06)
+53 if $PIECE(ZNODE,"^",4)'=""
SET PSOREPFQ=$PIECE(ZNODE,"^",4)
+54 if $PIECE(ZNODE,"^",5)'=""
SET PSOTXRTS=$PIECE(ZNODE,"^",5)
+55 if $PIECE(ZNODE,"^",6)'=""
SET PSOTXMOD=$PIECE(ZNODE,"^",6)
+56 if $PIECE(ZNODE,"^",7)'=""
SET PSORENAM=$PIECE(ZNODE,"^",7)
+57 if $PIECE(ZNODE,"^",8)'=""
SET PSOSNDPR=$PIECE(ZNODE,"^",8)
+58 if $PIECE(FNODE,"^",1)'=""
SET PSOVMSLD=$PIECE(FNODE,"^",1)
+59 if $PIECE(FNODE,"^",2)'=""
SET PSOPFIX=$PIECE(FNODE,"^",2)
+60 if $PIECE(FNODE,"^",3)'=""
SET PSOEXT=$PIECE(FNODE,"^",3)
+61 if $PIECE(FNODE,"^",4)'=""
SET PSOFTPIP=$PIECE(FNODE,"^",4)
+62 if $PIECE(FNODE,"^",5)'=""
SET PSOFTPUS=$PIECE(FNODE,"^",5)
+63 if $PIECE(FNODE,"^",6)'=""
SET PSOFTPPN=$PIECE(FNODE,"^",6)
+64 if $PIECE(FNODE,"^",7)'=""
SET PSOFTPDR=$PIECE(FNODE,"^",7)
+65 if $PIECE(F1NODE,"^",1)'=""
SET PSOUNXLD=$PIECE(F1NODE,"^",1)
End DoDot:1
+66 QUIT
+67 ;
CHANGED(STATE,FIELD,VALUE) ; - If field was change Automatically Invokes SAVE
+1 ;Input : STATE - Pointer to STATE file (#5)
+2 ; FIELD - Field ID (Internal)
+3 ; VALUE - Field Value
+4 NEW CHANGED,ZNODE,FNODE,F1NODE,LINE
+5 ;
+6 SET CHANGED=0
+7 ; - Saved Division's parameters
+8 SET ZNODE=$GET(^PS(58.41,STATE,0))
SET FNODE=$GET(^PS(58.41,STATE,"FILE"))
SET F1NODE=$GET(^PS(58.41,STATE,"FILE1"))
+9 ;Zero Report node
SET ONENODE=$GET(^PS(58.41,STATE,1))
+10 ;
+11 IF FIELD="ASAPVER"
IF VALUE'=$PIECE(ZNODE,"^",2)
SET CHANGED=1
+12 IF FIELD="TRXRTS"
IF VALUE'=$PIECE(ZNODE,"^",5)
SET CHANGED=1
+13 IF FIELD="ZEROVER"
IF VALUE'=$PIECE(ONENODE,"^",1)
SET CHANGED=1
+14 IF FIELD="ZERODIV"
IF VALUE'=$PIECE(ONENODE,"^",2)
SET CHANGED=1
+15 IF FIELD="INCNVET"
IF VALUE'=$PIECE(ZNODE,"^",3)
SET CHANGED=1
+16 IF FIELD="VMSLDIR"
IF VALUE'=$PIECE(FNODE,"^",1)
SET CHANGED=1
+17 IF FIELD="UNXLDIR"
IF VALUE'=$PIECE(F1NODE,"^",1)
SET CHANGED=1
+18 IF FIELD="WINLDIR"
IF VALUE'=$PIECE(F1NODE,"^",2)
SET CHANGED=1
+19 IF FIELD="REPFRQ"
IF VALUE'=$PIECE(ZNODE,"^",4)
SET CHANGED=1
+20 IF FIELD="FILEPFIX"
IF VALUE'=$PIECE(FNODE,"^",2)
SET CHANGED=1
+21 IF FIELD="FILEEXT"
IF VALUE'=$PIECE(FNODE,"^",3)
SET CHANGED=1
+22 IF FIELD="RENAME"
IF VALUE'=$PIECE(ZNODE,"^",7)
SET CHANGED=1
+23 IF FIELD="FTPIP"
IF VALUE'=$PIECE(FNODE,"^",4)
SET CHANGED=1
+24 IF FIELD="FTPUSER"
IF VALUE'=$PIECE(FNODE,"^",5)
SET CHANGED=1
+25 IF FIELD="FTPPORT"
IF VALUE'=$PIECE(FNODE,"^",6)
SET CHANGED=1
+26 IF FIELD="FTPDIR"
IF VALUE'=$PIECE(FNODE,"^",7)
SET CHANGED=1
+27 IF FIELD="TRXMODE"
IF VALUE'=$PIECE(ZNODE,"^",6)
SET CHANGED=1
+28 IF FIELD="SNDPRMT"
IF VALUE'=$PIECE(ZNODE,"^",8)
SET CHANGED=1
+29 ;
+30 IF CHANGED
DO SAVE(STATE,FIELD,$GET(VALUE))
+31 QUIT
+32 ;
SAVE(STATE,FIELD,VALUE) ; - Saves preferences by State
+1 ;Input : STATE - Pointer to STATE file (#5)
+2 ; FIELD - Field ID (Internal)
+3 ; VALUE - Field Value
+4 NEW DIE,DR,DA,LINE
+5 ;
+6 IF '$DATA(^PS(58.41,STATE))
Begin DoDot:1
+7 NEW %,DIC,DR,DA,X,DINUM,DLAYGO,DD,DO
+8 SET DIC="^PS(58.41,"
SET (DINUM,X)=STATE
SET DIC(0)=""
+9 KILL DD,DO
DO FILE^DICN
KILL DD,DO
End DoDot:1
+10 ;
+11 IF FIELD="ASAPVER"
SET DR="1///"_PSOASVER
+12 IF FIELD="TRXRTS"
SET DR="12////"_PSOTXRTS
+13 IF FIELD="ZEROVER"
SET DR="20///"_$SELECT(PSOZRVER="":"@",1:PSOZRVER)
+14 IF FIELD="ZERODIV"
SET DR="22////"_$SELECT(PSOZRDIV="":"@",1:PSOZRDIV)
+15 IF FIELD="INCNVET"
SET DR="2///"_PSOINCNV
+16 IF FIELD="VMSLDIR"
SET DR="4////"_$SELECT(PSOVMSLD="":"@",1:PSOVMSLD)
+17 IF FIELD="UNXLDIR"
SET DR="15////"_$SELECT(PSOUNXLD="":"@",1:PSOUNXLD)
+18 IF FIELD="REPFRQ"
SET DR="3///"_PSOREPFQ
+19 IF FIELD="FILEPFIX"
SET DR="5////"_$SELECT(PSOPFIX="":"@",1:PSOPFIX)
+20 IF FIELD="FILEEXT"
SET DR="6///"_PSOEXT
+21 IF FIELD="RENAME"
SET DR="17///"_PSORENAM
+22 IF FIELD="FTPIP"
SET DR="7///"_PSOFTPIP
+23 IF FIELD="FTPUSER"
SET DR="8///"_PSOFTPUS
+24 IF FIELD="FTPPORT"
SET DR="9////"_$SELECT(PSOFTPPN="":"@",1:PSOFTPPN)
+25 IF FIELD="FTPDIR"
SET DR="10////"_$SELECT(PSOFTPDR="":"@",1:PSOFTPDR)
+26 IF FIELD="TRXMODE"
SET DR="13////"_PSOTXMOD
+27 IF FIELD="SNDPRMT"
SET DR="21////"_PSOSNDPR
+28 SET DIE="^PS(58.41,"
SET DA=STATE
DO ^DIE
+29 QUIT
