PSOSPMSP.m

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 ---PSOSPMSP   15126     printed  Mar 13, 2025@21:40:04                                                                                                                                                                                                   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