PSOBPSSP ;BIRM/LE - ePharmacy Site Parameters Definition ;04/28/08
;;7.0;OUTPATIENT PHARMACY;**289,385,421,427,482,562**;DEC 1997;Build 19
;
; Patch 421 replaced all logic in this module as the original
; screen has been replaced by a List Manager screen.
;
; GETDATA^PSOBPSSP - Populates the List Manager Array
; EN^PSOBPSSL - Site parameter lister
;
EN ; - Prompt for ePharmacy Site Parameters
;
; PSODIV is the IEN of the initially selected division
; PSOBPSDV is the IEN of the current ePharmacy division being edited.
; PSOSITE & PSOPAR are populated by the call to ^PSOLSET in DIV
;
; LOCK THE SITE PARAMETER FILE
L +^PS(52.86,"LOCK"):0
I '$T D Q
. W !!?2,"Sorry, another user is currently using the ePharmacy Site Parameters option."
. W !?2,"Please try again later."
. D PAUSE^VALM1
. Q
;
N PSODIV,PSOBPSDV,PSOSITE,PSOPAR
D DIV
I '$G(PSOSITE) L -^PS(52.86,"LOCK") Q
;
; Informational Messages
D TRCMSG^PSOBPSSL,RRRMSG^PSOBPSSL W !
;
D EN^VALM("PSO EPHARM SITE PARAMS")
L -^PS(52.86,"LOCK") ; option level unlock
Q
;
HDR ; -- header code -- PSO EPHARM SITE PARAMS
S VALMHDR(1)="Pharmacy Division: "_$$GET1^DIQ(52.86,PSOBPSDV_",",.01)
Q
;
INIT ; -- init variables and list array -- PSO EPHARM SITE PARAMS
; PSOBPSDV is the IEN of the current division being edited. (NEWed in EN)
; Get the division number
K PSOBPSDV D GETDIV(.PSOBPSDV)
I '$D(PSOBPSDV) S VALMQUIT=1 Q
D RBUILD
Q
;
HELP ; -- help code -- PSO EPHARM SITE PARAMS
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
;
K PSOBPSDV,PSODIV,^TMP("PSOBPSSP",$J)
Q
;
EXPND ; -- expand code
Q
;
GETDIV(DIV) ; Gets a single division. If it does not exist, the new division is created
; and the user is prompted for worklist days.
; Called by INIT on entry and when Change Division action is selected
; DIV - ePharmacy site parameter IEN - Parameters for division pointed to in .01 field
;
N DIC,DTOUT,DUOUT,DLAYGO,X,Y ; Variables for ^DIC
S DIC("A")="Select a Pharmacy Division: " S DIC=52.86,DIC(0)="AEBQL",DLAYGO=52.86 D ^DIC
Q:($G(DTOUT))!($D(DUOUT)!(Y<0))
S DIV=$P(Y,U,1)
Q
;
BLDLIST(DIV) ; Rebuilds the List Manager array
;
; DIV is the IEN of the current division being edited. (NEWed in EN)
; LINECT - keeps track of the line count in the display list
; LMARRAY - List Manager Array Name
;
N LMARRAY,LINECT
;
; Initialize the Line Counter
S LINECT=0
;
; This is the List Manager Array
D CLEAN^VALM10
S LMARRAY=$NA(^TMP("PSOBPSSP",$J)) K @LMARRAY
;
; Get the current data for the selected division
D GETDATA^PSOBPSSL(DIV,LMARRAY,.LINECT)
S VALMCNT=LINECT
Q
;
DIV ; Establish the PSO Site information - Also called by PSOBPSSL Division/Site selection
;
; PSOSITE and PSOPAR are set by ^PSOLSET - Declared in EN of calling routines
;
I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
W !!
Q
;
CPYSITES(DIVS,CTR,CDIV,SCR) ; Procedure for picking sites for the copy function.
; Cloned from SEL^PSOREJU1 with changes for Site Parameter Copy action
;
; Input Parameters
; DIVS - passed by reference and will hold the divisions to process
; CTR - passed by reference, returns the number of divisions picked.
; CDIV - source site parameter pharmacy division IEN (ptr to file 59).
; SCR - Screen to prevent source division from being selected.
;
; Variables used by ^DIC
N DIC,DTOUT,DUOUT,Y,X
;
; Local Variables
; PSOI - Pharmacy IEN from file 59
; QT - used to control when to exit
; CTR -counts the number of sites selected
N PSOI,QT
;
S (QT,CTR)=0
;
; Instructional message
W !,"You may select a single or multiple Pharmacy Divisions,"
W !,"or enter ^ALL to select all Pharmacy Divisions.",!
;
; Set up ^DIC call
K DIVS S DIC="^PS(59,",DIC(0)="QEZAM"
S DIC("A")="Select a Pharmacy Division to be overwritten: "
S DIC("S")=$G(SCR)
;
; Loop through Selections
F D ^DIC Q:X=""!QT D Q:QT
. ;
. ; Special processing if ^ALL was entered
. I $$UP^XLFSTR(X)="^ALL" K DIVS S CTR=0,DIVS="ALL",QT=1 D Q
. . S PSOI=0 F S PSOI=$O(^PS(59,PSOI)) Q:'PSOI D:PSOI'=CDIV
. . . S CTR=CTR+1,DIVS(PSOI)=$$GET1^DIQ(59,PSOI,.01)
. ;
. ; Quit if timeout or a ^
. I $G(DTOUT)!$G(DUOUT) K DIVS S DIVS="^",QT=1 Q
. ;
. ; do not save if the source division is picked
. I +Y=CDIV W !,"The source Pharmacy Division cannot be copied to itself."
. ;
. ; Do not allow duplicate selections
. I +Y'=CDIV,$D(DIVS(+Y)) W $P(Y,U,2)_" is already selected." Q
. ;
. ; Processing for selected divisions
. S DIVS(+Y)=$P(Y,U,2),CTR=CTR+1
. ;
. ; prompt for another division
. W ! S DIC("A")="ANOTHER ONE: " K DIC("B")
. Q
;
I '$D(DIVS) S DIVS="^"
Q
;
COPYSP ; Action for CP Copy Parameters
; From EN
; PSOBPSDV - source site parameter IEN of 52.86 - defined in EN
;
; Local Variables
; CDIV - current site parameter division to copy to
; CPDIV - source site parameter pharmacy division IEN (ptr to file 59)
; CPYDIVS - array pharmacy divisions where to copy parameters
; NOTE: The subscripts for CPYDIVS will be the selected IENS from file 59
; CPYFDA - FDA array used in UPDATE^DIE calls
; CPNAME - source site parameter pharmacy division name from file 59
; DIVCT - holds the return value of the number so sites picked when CPYSITES is called
; IROOT - Returns new IEN after UPDATE^DIE
; PARAMS - local array to hold the parameters from the source site
; PSOI & PSOJ - loop counters
N CDIV,CPDIV,CPYFDA,CPYDIVS,CPNAME,DIVCT,IROOT,PARAMS,PSOI,PSOJ
;
; Used by ^DIK
N DIK,DA
;
; Used by ^DIR
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
;
; Set Full Screen mode
D FULL^VALM1
;
; Get the current ePharmacy Site Parameter IEN and division name
S CPDIV=$$GET1^DIQ(52.86,PSOBPSDV_",",.01,"I")
S CPNAME=$$GET1^DIQ(52.86,PSOBPSDV_",",.01,"E")
;
; FIRST PART OF INSTRUCTION MESSAGE
W !!,"The parameters will be copied from "_CPNAME_" Division.",!
W !,"Select the Pharmacy Division(s) to overwrite."
;
; Select the desired divisions where to copy parameters
; The screen value ("I $QS($NA(^(0)),2)'="_CPDIV) will
; eliminate the source division from the copy to choices
D CPYSITES(.CPYDIVS,.DIVCT,CPDIV,"I $QS($NA(^(0)),2)'="_CPDIV)
;
; Quit if no divisions selected
I $D(CPYDIVS)<10!(+$G(DIVCT)=0) G EXITCPY
;
; Are you sure code
;
; Get and display current pharmacy name
S CPNAME=$$GET1^DIQ(52.86,PSOBPSDV_",",.01)
W !!,"The parameters from Pharmacy Division "_CPNAME
W !,"will overwrite the parameters in Pharmacy Division"_$S(DIVCT>1:"s:",1:":")
;
; Loop through all the divisions returned by CPYSITES and display their names
S PSOI=0 W ! F S PSOI=$O(CPYDIVS(PSOI)) Q:'PSOI W !,CPYDIVS(PSOI)
;
; Are you sure code
W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO" D ^DIR
I ('Y)!($G(DUOUT))!($G(DTOUT)) G EXITCPY
;
; Load the source division parameters
D GETS^DIQ(52.86,PSOBPSDV_",","**","I","PARAMS")
; Copy the division settings (except user updated by and date/times - these are triggered)
S PSOI=0 F S PSOI=$O(CPYDIVS(PSOI)) Q:'PSOI D
. ;
. ; If the parameters exist for this division, delete them
. S CDIV=0,CDIV=$O(^PS(52.86,"B",PSOI,CDIV)) ; Check B index for pharmacy division
. I CDIV S DA=CDIV,DIK="^PS(52.86," D ^DIK ; Delete parameters if they exist
. ;
. ; Create the FDA and file the general parameters
. K CPYFDA
. S CPYFDA(52.86,"+1,",.01)=PSOI
. S CPYFDA(52.86,"+1,",4)=+$G(PARAMS(52.86,PSOBPSDV_",",4,"I"))
. S CPYFDA(52.86,"+1,",6)=+$G(PARAMS(52.86,PSOBPSDV_",",6,"I"))
. I $G(PARAMS(52.86,PSOBPSDV_",",7,"I"))'="" D
. . S CPYFDA(52.86,"+1,",7)=+$G(PARAMS(52.86,PSOBPSDV_",",7,"I"))
. K IROOT D UPDATE^DIE(,"CPYFDA","IROOT") S CDIV=IROOT(1)
. ;
. ; Loop through and copy the transfer reject codes
. ; Create the FDA and UPDATE the subfile 52.8651
. I $D(PARAMS(52.8651)) S PSOJ=0 F S PSOJ=$O(PARAMS(52.8651,PSOJ)) Q:'PSOJ D
. . K CPYFDA
. . S CPYFDA(52.8651,"+1,"_CDIV_",",.01)=PARAMS(52.8651,PSOJ,.01,"I")
. . S CPYFDA(52.8651,"+1,"_CDIV_",",1)=PARAMS(52.8651,PSOJ,1,"I")
. . D UPDATE^DIE(,"CPYFDA")
. . Q
. ;
. ; Loop through and copy the reject resolution required codes
. ; Create the FDA and UPDATE the subfile 52.865
. I $D(PARAMS(52.865)) S PSOJ="" F S PSOJ=$O(PARAMS(52.865,PSOJ)) Q:'PSOJ D
. . K CPYFDA
. . S CPYFDA(52.865,"+1,"_CDIV_",",.01)=PARAMS(52.865,PSOJ,.01,"I")
. . S CPYFDA(52.865,"+1,"_CDIV_",",.02)=PARAMS(52.865,PSOJ,.02,"I")
. . D UPDATE^DIE(,"CPYFDA")
. . Q
. Q
EXITCPY ;
D RBUILD
Q
;
CHGDIV ; Action for CD Change Division
;
; From EN
; PSOBPSDV - source site parameter IEN of 52.86 - defined in EN
;
; Local Variable
; TMPDIV - used to save the current division number in case the user does not pick one
N TMPDIV
;
; Set Full Screen mode
D FULL^VALM1
;
; save current division
S TMPDIV=PSOBPSDV
;
; Kill the current division
K PSOBPSDV
;
; Get the division number to process
D GETDIV(.PSOBPSDV)
;
; if no division selected, restore current division
I '$D(PSOBPSDV) D Q
. S PSOBPSDV=TMPDIV
. D RBUILD
S VALMHDR(1)="Pharmacy Division: "_$$GET1^DIQ(52.86,PSOBPSDV_",",.01)
S VALMBG=1
D RBUILD
Q
;
DIVLIST ; Action for DP Display site parameters
;
; Set Full Screen mode
D FULL^VALM1
;
; Call List Manager routine for displaying site parameters for multiple divisions
D EN^PSOBPSSL
;
D RBUILD
Q
;
RBUILD ; rebuild the list and then exit with a refresh
;
; From EN
; PSOBPSDV - source site parameter IEN of 52.86 - defined in EN
;
; VALMBK - List Manager variable
;
D BLDLIST(PSOBPSDV)
;
S VALMBCK="R"
Q
;
EDITALL ; Action for EA Edit All Parameters
;
; Moved to ^PSOBPSS2 due to space.
;
D EDITALL^PSOBPSS2
;
Q
;
EDITGEN ; Action for EG Edit General Parameters
;
; Moved to ^PSOBPSS2 due to space.
;
D EDITGEN^PSOBPSS2
;
Q
;
EDITTRC ; Action for ET Edit Transfer Reject Code
;
; Moved to ^PSOBPSS2 due to space.
;
D EDITTRC^PSOBPSS2
;
Q
;
EDITRRRC ; Action for ER Edit Reject Resolution Required Code
;
; Moved to ^PSOBPSS2 due to space.
;
D EDITRRRC^PSOBPSS2
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBPSSP 10365 printed Oct 16, 2024@18:25:40 Page 2
PSOBPSSP ;BIRM/LE - ePharmacy Site Parameters Definition ;04/28/08
+1 ;;7.0;OUTPATIENT PHARMACY;**289,385,421,427,482,562**;DEC 1997;Build 19
+2 ;
+3 ; Patch 421 replaced all logic in this module as the original
+4 ; screen has been replaced by a List Manager screen.
+5 ;
+6 ; GETDATA^PSOBPSSP - Populates the List Manager Array
+7 ; EN^PSOBPSSL - Site parameter lister
+8 ;
EN ; - Prompt for ePharmacy Site Parameters
+1 ;
+2 ; PSODIV is the IEN of the initially selected division
+3 ; PSOBPSDV is the IEN of the current ePharmacy division being edited.
+4 ; PSOSITE & PSOPAR are populated by the call to ^PSOLSET in DIV
+5 ;
+6 ; LOCK THE SITE PARAMETER FILE
+7 LOCK +^PS(52.86,"LOCK"):0
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !!?2,"Sorry, another user is currently using the ePharmacy Site Parameters option."
+10 WRITE !?2,"Please try again later."
+11 DO PAUSE^VALM1
+12 QUIT
End DoDot:1
QUIT
+13 ;
+14 NEW PSODIV,PSOBPSDV,PSOSITE,PSOPAR
+15 DO DIV
+16 IF '$GET(PSOSITE)
LOCK -^PS(52.86,"LOCK")
QUIT
+17 ;
+18 ; Informational Messages
+19 DO TRCMSG^PSOBPSSL
DO RRRMSG^PSOBPSSL
WRITE !
+20 ;
+21 DO EN^VALM("PSO EPHARM SITE PARAMS")
+22 ; option level unlock
LOCK -^PS(52.86,"LOCK")
+23 QUIT
+24 ;
HDR ; -- header code -- PSO EPHARM SITE PARAMS
+1 SET VALMHDR(1)="Pharmacy Division: "_$$GET1^DIQ(52.86,PSOBPSDV_",",.01)
+2 QUIT
+3 ;
INIT ; -- init variables and list array -- PSO EPHARM SITE PARAMS
+1 ; PSOBPSDV is the IEN of the current division being edited. (NEWed in EN)
+2 ; Get the division number
+3 KILL PSOBPSDV
DO GETDIV(.PSOBPSDV)
+4 IF '$DATA(PSOBPSDV)
SET VALMQUIT=1
QUIT
+5 DO RBUILD
+6 QUIT
+7 ;
HELP ; -- help code -- PSO EPHARM SITE PARAMS
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 ;
+2 KILL PSOBPSDV,PSODIV,^TMP("PSOBPSSP",$JOB)
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
GETDIV(DIV) ; Gets a single division. If it does not exist, the new division is created
+1 ; and the user is prompted for worklist days.
+2 ; Called by INIT on entry and when Change Division action is selected
+3 ; DIV - ePharmacy site parameter IEN - Parameters for division pointed to in .01 field
+4 ;
+5 ; Variables for ^DIC
NEW DIC,DTOUT,DUOUT,DLAYGO,X,Y
+6 SET DIC("A")="Select a Pharmacy Division: "
SET DIC=52.86
SET DIC(0)="AEBQL"
SET DLAYGO=52.86
DO ^DIC
+7 if ($GET(DTOUT))!($DATA(DUOUT)!(Y<0))
QUIT
+8 SET DIV=$PIECE(Y,U,1)
+9 QUIT
+10 ;
BLDLIST(DIV) ; Rebuilds the List Manager array
+1 ;
+2 ; DIV is the IEN of the current division being edited. (NEWed in EN)
+3 ; LINECT - keeps track of the line count in the display list
+4 ; LMARRAY - List Manager Array Name
+5 ;
+6 NEW LMARRAY,LINECT
+7 ;
+8 ; Initialize the Line Counter
+9 SET LINECT=0
+10 ;
+11 ; This is the List Manager Array
+12 DO CLEAN^VALM10
+13 SET LMARRAY=$NAME(^TMP("PSOBPSSP",$JOB))
KILL @LMARRAY
+14 ;
+15 ; Get the current data for the selected division
+16 DO GETDATA^PSOBPSSL(DIV,LMARRAY,.LINECT)
+17 SET VALMCNT=LINECT
+18 QUIT
+19 ;
DIV ; Establish the PSO Site information - Also called by PSOBPSSL Division/Site selection
+1 ;
+2 ; PSOSITE and PSOPAR are set by ^PSOLSET - Declared in EN of calling routines
+3 ;
+4 IF '$GET(PSOSITE)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
QUIT
+5 WRITE !!
+6 QUIT
+7 ;
CPYSITES(DIVS,CTR,CDIV,SCR) ; Procedure for picking sites for the copy function.
+1 ; Cloned from SEL^PSOREJU1 with changes for Site Parameter Copy action
+2 ;
+3 ; Input Parameters
+4 ; DIVS - passed by reference and will hold the divisions to process
+5 ; CTR - passed by reference, returns the number of divisions picked.
+6 ; CDIV - source site parameter pharmacy division IEN (ptr to file 59).
+7 ; SCR - Screen to prevent source division from being selected.
+8 ;
+9 ; Variables used by ^DIC
+10 NEW DIC,DTOUT,DUOUT,Y,X
+11 ;
+12 ; Local Variables
+13 ; PSOI - Pharmacy IEN from file 59
+14 ; QT - used to control when to exit
+15 ; CTR -counts the number of sites selected
+16 NEW PSOI,QT
+17 ;
+18 SET (QT,CTR)=0
+19 ;
+20 ; Instructional message
+21 WRITE !,"You may select a single or multiple Pharmacy Divisions,"
+22 WRITE !,"or enter ^ALL to select all Pharmacy Divisions.",!
+23 ;
+24 ; Set up ^DIC call
+25 KILL DIVS
SET DIC="^PS(59,"
SET DIC(0)="QEZAM"
+26 SET DIC("A")="Select a Pharmacy Division to be overwritten: "
+27 SET DIC("S")=$GET(SCR)
+28 ;
+29 ; Loop through Selections
+30 FOR
DO ^DIC
if X=""!QT
QUIT
Begin DoDot:1
+31 ;
+32 ; Special processing if ^ALL was entered
+33 IF $$UP^XLFSTR(X)="^ALL"
KILL DIVS
SET CTR=0
SET DIVS="ALL"
SET QT=1
Begin DoDot:2
+34 SET PSOI=0
FOR
SET PSOI=$ORDER(^PS(59,PSOI))
if 'PSOI
QUIT
if PSOI'=CDIV
Begin DoDot:3
+35 SET CTR=CTR+1
SET DIVS(PSOI)=$$GET1^DIQ(59,PSOI,.01)
End DoDot:3
End DoDot:2
QUIT
+36 ;
+37 ; Quit if timeout or a ^
+38 IF $GET(DTOUT)!$GET(DUOUT)
KILL DIVS
SET DIVS="^"
SET QT=1
QUIT
+39 ;
+40 ; do not save if the source division is picked
+41 IF +Y=CDIV
WRITE !,"The source Pharmacy Division cannot be copied to itself."
+42 ;
+43 ; Do not allow duplicate selections
+44 IF +Y'=CDIV
IF $DATA(DIVS(+Y))
WRITE $PIECE(Y,U,2)_" is already selected."
QUIT
+45 ;
+46 ; Processing for selected divisions
+47 SET DIVS(+Y)=$PIECE(Y,U,2)
SET CTR=CTR+1
+48 ;
+49 ; prompt for another division
+50 WRITE !
SET DIC("A")="ANOTHER ONE: "
KILL DIC("B")
+51 QUIT
End DoDot:1
if QT
QUIT
+52 ;
+53 IF '$DATA(DIVS)
SET DIVS="^"
+54 QUIT
+55 ;
COPYSP ; Action for CP Copy Parameters
+1 ; From EN
+2 ; PSOBPSDV - source site parameter IEN of 52.86 - defined in EN
+3 ;
+4 ; Local Variables
+5 ; CDIV - current site parameter division to copy to
+6 ; CPDIV - source site parameter pharmacy division IEN (ptr to file 59)
+7 ; CPYDIVS - array pharmacy divisions where to copy parameters
+8 ; NOTE: The subscripts for CPYDIVS will be the selected IENS from file 59
+9 ; CPYFDA - FDA array used in UPDATE^DIE calls
+10 ; CPNAME - source site parameter pharmacy division name from file 59
+11 ; DIVCT - holds the return value of the number so sites picked when CPYSITES is called
+12 ; IROOT - Returns new IEN after UPDATE^DIE
+13 ; PARAMS - local array to hold the parameters from the source site
+14 ; PSOI & PSOJ - loop counters
+15 NEW CDIV,CPDIV,CPYFDA,CPYDIVS,CPNAME,DIVCT,IROOT,PARAMS,PSOI,PSOJ
+16 ;
+17 ; Used by ^DIK
+18 NEW DIK,DA
+19 ;
+20 ; Used by ^DIR
+21 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+22 ;
+23 ; Set Full Screen mode
+24 DO FULL^VALM1
+25 ;
+26 ; Get the current ePharmacy Site Parameter IEN and division name
+27 SET CPDIV=$$GET1^DIQ(52.86,PSOBPSDV_",",.01,"I")
+28 SET CPNAME=$$GET1^DIQ(52.86,PSOBPSDV_",",.01,"E")
+29 ;
+30 ; FIRST PART OF INSTRUCTION MESSAGE
+31 WRITE !!,"The parameters will be copied from "_CPNAME_" Division.",!
+32 WRITE !,"Select the Pharmacy Division(s) to overwrite."
+33 ;
+34 ; Select the desired divisions where to copy parameters
+35 ; The screen value ("I $QS($NA(^(0)),2)'="_CPDIV) will
+36 ; eliminate the source division from the copy to choices
+37 DO CPYSITES(.CPYDIVS,.DIVCT,CPDIV,"I $QS($NA(^(0)),2)'="_CPDIV)
+38 ;
+39 ; Quit if no divisions selected
+40 IF $DATA(CPYDIVS)<10!(+$GET(DIVCT)=0)
GOTO EXITCPY
+41 ;
+42 ; Are you sure code
+43 ;
+44 ; Get and display current pharmacy name
+45 SET CPNAME=$$GET1^DIQ(52.86,PSOBPSDV_",",.01)
+46 WRITE !!,"The parameters from Pharmacy Division "_CPNAME
+47 WRITE !,"will overwrite the parameters in Pharmacy Division"_$SELECT(DIVCT>1:"s:",1:":")
+48 ;
+49 ; Loop through all the divisions returned by CPYSITES and display their names
+50 SET PSOI=0
WRITE !
FOR
SET PSOI=$ORDER(CPYDIVS(PSOI))
if 'PSOI
QUIT
WRITE !,CPYDIVS(PSOI)
+51 ;
+52 ; Are you sure code
+53 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="NO"
DO ^DIR
+54 IF ('Y)!($GET(DUOUT))!($GET(DTOUT))
GOTO EXITCPY
+55 ;
+56 ; Load the source division parameters
+57 DO GETS^DIQ(52.86,PSOBPSDV_",","**","I","PARAMS")
+58 ; Copy the division settings (except user updated by and date/times - these are triggered)
+59 SET PSOI=0
FOR
SET PSOI=$ORDER(CPYDIVS(PSOI))
if 'PSOI
QUIT
Begin DoDot:1
+60 ;
+61 ; If the parameters exist for this division, delete them
+62 ; Check B index for pharmacy division
SET CDIV=0
SET CDIV=$ORDER(^PS(52.86,"B",PSOI,CDIV))
+63 ; Delete parameters if they exist
IF CDIV
SET DA=CDIV
SET DIK="^PS(52.86,"
DO ^DIK
+64 ;
+65 ; Create the FDA and file the general parameters
+66 KILL CPYFDA
+67 SET CPYFDA(52.86,"+1,",.01)=PSOI
+68 SET CPYFDA(52.86,"+1,",4)=+$GET(PARAMS(52.86,PSOBPSDV_",",4,"I"))
+69 SET CPYFDA(52.86,"+1,",6)=+$GET(PARAMS(52.86,PSOBPSDV_",",6,"I"))
+70 IF $GET(PARAMS(52.86,PSOBPSDV_",",7,"I"))'=""
Begin DoDot:2
+71 SET CPYFDA(52.86,"+1,",7)=+$GET(PARAMS(52.86,PSOBPSDV_",",7,"I"))
End DoDot:2
+72 KILL IROOT
DO UPDATE^DIE(,"CPYFDA","IROOT")
SET CDIV=IROOT(1)
+73 ;
+74 ; Loop through and copy the transfer reject codes
+75 ; Create the FDA and UPDATE the subfile 52.8651
+76 IF $DATA(PARAMS(52.8651))
SET PSOJ=0
FOR
SET PSOJ=$ORDER(PARAMS(52.8651,PSOJ))
if 'PSOJ
QUIT
Begin DoDot:2
+77 KILL CPYFDA
+78 SET CPYFDA(52.8651,"+1,"_CDIV_",",.01)=PARAMS(52.8651,PSOJ,.01,"I")
+79 SET CPYFDA(52.8651,"+1,"_CDIV_",",1)=PARAMS(52.8651,PSOJ,1,"I")
+80 DO UPDATE^DIE(,"CPYFDA")
+81 QUIT
End DoDot:2
+82 ;
+83 ; Loop through and copy the reject resolution required codes
+84 ; Create the FDA and UPDATE the subfile 52.865
+85 IF $DATA(PARAMS(52.865))
SET PSOJ=""
FOR
SET PSOJ=$ORDER(PARAMS(52.865,PSOJ))
if 'PSOJ
QUIT
Begin DoDot:2
+86 KILL CPYFDA
+87 SET CPYFDA(52.865,"+1,"_CDIV_",",.01)=PARAMS(52.865,PSOJ,.01,"I")
+88 SET CPYFDA(52.865,"+1,"_CDIV_",",.02)=PARAMS(52.865,PSOJ,.02,"I")
+89 DO UPDATE^DIE(,"CPYFDA")
+90 QUIT
End DoDot:2
+91 QUIT
End DoDot:1
EXITCPY ;
+1 DO RBUILD
+2 QUIT
+3 ;
CHGDIV ; Action for CD Change Division
+1 ;
+2 ; From EN
+3 ; PSOBPSDV - source site parameter IEN of 52.86 - defined in EN
+4 ;
+5 ; Local Variable
+6 ; TMPDIV - used to save the current division number in case the user does not pick one
+7 NEW TMPDIV
+8 ;
+9 ; Set Full Screen mode
+10 DO FULL^VALM1
+11 ;
+12 ; save current division
+13 SET TMPDIV=PSOBPSDV
+14 ;
+15 ; Kill the current division
+16 KILL PSOBPSDV
+17 ;
+18 ; Get the division number to process
+19 DO GETDIV(.PSOBPSDV)
+20 ;
+21 ; if no division selected, restore current division
+22 IF '$DATA(PSOBPSDV)
Begin DoDot:1
+23 SET PSOBPSDV=TMPDIV
+24 DO RBUILD
End DoDot:1
QUIT
+25 SET VALMHDR(1)="Pharmacy Division: "_$$GET1^DIQ(52.86,PSOBPSDV_",",.01)
+26 SET VALMBG=1
+27 DO RBUILD
+28 QUIT
+29 ;
DIVLIST ; Action for DP Display site parameters
+1 ;
+2 ; Set Full Screen mode
+3 DO FULL^VALM1
+4 ;
+5 ; Call List Manager routine for displaying site parameters for multiple divisions
+6 DO EN^PSOBPSSL
+7 ;
+8 DO RBUILD
+9 QUIT
+10 ;
RBUILD ; rebuild the list and then exit with a refresh
+1 ;
+2 ; From EN
+3 ; PSOBPSDV - source site parameter IEN of 52.86 - defined in EN
+4 ;
+5 ; VALMBK - List Manager variable
+6 ;
+7 DO BLDLIST(PSOBPSDV)
+8 ;
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
EDITALL ; Action for EA Edit All Parameters
+1 ;
+2 ; Moved to ^PSOBPSS2 due to space.
+3 ;
+4 DO EDITALL^PSOBPSS2
+5 ;
+6 QUIT
+7 ;
EDITGEN ; Action for EG Edit General Parameters
+1 ;
+2 ; Moved to ^PSOBPSS2 due to space.
+3 ;
+4 DO EDITGEN^PSOBPSS2
+5 ;
+6 QUIT
+7 ;
EDITTRC ; Action for ET Edit Transfer Reject Code
+1 ;
+2 ; Moved to ^PSOBPSS2 due to space.
+3 ;
+4 DO EDITTRC^PSOBPSS2
+5 ;
+6 QUIT
+7 ;
EDITRRRC ; Action for ER Edit Reject Resolution Required Code
+1 ;
+2 ; Moved to ^PSOBPSS2 due to space.
+3 ;
+4 DO EDITRRRC^PSOBPSS2
+5 ;
+6 QUIT
+7 ;
