PSOSPML3 ;BIRM/MFR - ASAP Definitions Listman Driver ;09/01/12
;;7.0;OUTPATIENT PHARMACY;**408,451,625,772**;DEC 1997;Build 105
;
N ASAPVER,VERLST,DIR,DIRUT,DTOUT,X,Y,DIC,VALM,VALMBG,VALMCNT,VALMHDR,VALMBCK,VALMSG,PSOLSTLN
;
VER ; ASAP Version Prompt
W ! S ASAPVER=$$ASAPVER^PSOSPMU2("A","B",1) I ASAPVER["^"!(ASAPVER="") G EXIT ;adding "B" for Zero Report
;
D EN(ASAPVER,0)
;
G VER
;
EN(PSOASVER,PSOSHOW) ; Entry point
;Input: (r) PSOASVER - ASAP Version ("3.0", "4.0", etc.)
; (o) PSOSHOW - 0: Segments Only
; 1: Segments & Data Elements (ID and Name Only)
; 2: Segments & Data Elements (All Details)
N ASAP
S PSOSHOW=+$G(PSOSHOW)
D EN^VALM("PSO SPMP VIEW ASAP DEFINITION")
D FULL^VALM1
Q
;
HDR ; - Builds the Header section
N STDIEN,VERIEN,HDR,ELMDELIM,SEGTERM,EOSCHR,STDVDLMS,ALLVDLMS,CLONE,HDRLINE,HDR ; PSO*7*772 CLONE
S STDVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"S")
S ALLVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"B")
S STDIEN=$O(^PS(58.4,"B","STANDARD ASAP DEFINITION",0))
S VERIEN=$O(^PS(58.4,STDIEN,"VER","B",PSOASVER,0))
S CLONE=$P(STDVDLMS,"^",6),HDRLINE=1 ; PSO*7*772 - Cloned ASAP Version
S VALM("TITLE")=" ASAP "_$S('VERIEN!$L(CLONE):"Custom",1:"Standard")_" Ver "_PSOASVER_$S('VERIEN!$L(CLONE):"*",1:"") ; PSO*7*772 Cloned ASAP Version
S ELMDELIM=$S(PSOASVER="1995":"N/A",1:$P(ALLVDLMS,"^",2))
S HDR(HDRLINE)="Copied From ASAP Version: "_$S($L(CLONE):CLONE,1:"N/A") D INSTR^VALM1(HDR(HDRLINE),2,HDRLINE+1) S HDRLINE=HDRLINE+1 ; PSO*7*772 Cloned ASAP Version
S HDR(HDRLINE)="Element Delimiter"_$S(($P(STDVDLMS,"^",2)'=""&($P(STDVDLMS,"^",2)'=$P(ALLVDLMS,"^",2))):"*",1:"")_":"_IOINHI_$S(ELMDELIM="":"<NULL>",1:" "_ELMDELIM)_IOINORM
S SEGTERM=$S(PSOASVER="1995":"N/A",1:$P(ALLVDLMS,"^",3))
S HDR(HDRLINE)=HDR(HDRLINE)_" Segment Terminator"_$S(($P(STDVDLMS,"^",3)'=""&($P(STDVDLMS,"^",3)'=$P(ALLVDLMS,"^",3))):"*",1:"")_":"_IOINHI_$S(SEGTERM="":"<NULL>",1:" "_SEGTERM)_IOINORM ; PSO*7*772 - Denote delimiter customization
S EOSCHR=$S(PSOASVER="1995":"$C(10,13)",1:$P(ALLVDLMS,"^",4))
S HDR(HDRLINE)=HDR(HDRLINE)_" End Of Line ESC"_$S(($P(STDVDLMS,"^",4)'=""&($P(STDVDLMS,"^",4)'=$P(ALLVDLMS,"^",4))):"*",1:"")_":"_IOINHI_$S(EOSCHR="":"<NULL>",1:" "_EOSCHR)_IOINORM
D INSTR^VALM1(HDR(HDRLINE),2,HDRLINE+1)
Q
;
INIT ; Builds the Body section
N ASAP,LINE,I
;
K ^TMP("PSOSPML3",$J) S VALMCNT=0,LINE=0
F I=1:1:1000 D RESTORE^VALM10(I)
I PSOASVER="1995" D
. D SETSEG95^PSOSPML4("PSOSPML3","") S VALMCNT=LINE
I PSOASVER'="1995" D
. D LOADASAP^PSOSPMU0(PSOASVER,"B",.ASAP)
. D SETSEG("ASAP",0) S VALMCNT=LINE
. S VALMSG="Enter ?? for more actions|* Custom Segment/Element"
Q
;
; Note: Recursivity used because of the 'Tree' nature of the ASAP definition
SETSEG(ARRNAM,LEVEL) ; Set list content with the Segment info
;Input: ARRNAM - Name of the Array containing the ASAP definition
; LEVEL - Level of the Segment
N ARRAY,COLUMN,TYPE,DETLN,SEGID,JUST,I,J,ELMCNT,LSTELM,ELMNAM,MVALUE,SEGLN,LEVNAM,DESCNT,VALIDX
;
S PSOSHOW=+$G(PSOSHOW)
S ARRAY=$Q(@ARRNAM) I '+$P(ARRAY,"(",2) Q
S SEGID=$P(@ARRAY,"^"),COLUMN=(($L(ARRAY,",")-1)*4)
S JUST="" S:PSOSHOW'=2 JUST=$J("",COLUMN)
I LEVEL'=$P(ASAP(SEGID),"^",6) D
. S LEVEL=$P(ASAP(SEGID),"^",6)
. S LEVNAM=$P("MAIN HEADER^PHARMACY HEADER^PATIENT DETAIL^PRESCRIPTION DETAIL^PHARMACY TRAILER^MAIN TRAILER","^",LEVEL)
. D SETLN^PSOSPMU1("PSOSPML3",JUST_LEVNAM,0,0,0)
. D CNTRL^VALM10(LINE,$L(JUST)+1,$L(LEVNAM),IORVON,IORVOFF_IOINORM)
S SEGLN=JUST_$P(ASAP(SEGID),"^")_$S($$CUSSEG^PSOSPMU3(PSOASVER,SEGID):"*",1:"")_" - "_$P(ASAP(SEGID),"^",2)_$S($P(ASAP(SEGID),"^",4)="N":" (Not Used)",1:"")
D SETLN^PSOSPMU1("PSOSPML3",SEGLN,0,$S(PSOSHOW'=0:1,1:0),$S($P(ASAP(SEGID),"^",4)="N":0,1:1))
S LSTELM=+$O(ASAP(SEGID,""),-1)
I PSOSHOW'=0 D
. F ELMCNT=1:1:LSTELM D
. . S:PSOSHOW=1 JUST=$J("",COLUMN+$L(SEGID)+1)
. . S ELMNAM=JUST_$P(ASAP(SEGID,ELMCNT),"^")_$S($G(ASAP(SEGID,ELMCNT,"CUS")):"*",1:"")_" - "_$P(ASAP(SEGID,ELMCNT),"^",2)
. . S ELMNAM=ELMNAM_$S((PSOSHOW=1)&($P(ASAP(SEGID,ELMCNT),"^",6)="N"):" (Not Used)",1:"")
. . D SETLN^PSOSPMU1("PSOSPML3",ELMNAM,0,0,$S((PSOSHOW=1)&($P(ASAP(SEGID,ELMCNT),"^",6)="N"):0,1:1))
. . I PSOSHOW=1 Q
. . S DETLN=JUST_"Requirement: "_$S($P(ASAP(SEGID,ELMCNT),"^",6)="R":"Required",$P(ASAP(SEGID,ELMCNT),"^",6)="O":"Optional",$P(ASAP(SEGID,ELMCNT),"^",6)="N":"Not Used",1:"")
. . S TYPE=$P(ASAP(SEGID,ELMCNT),"^",3)
. . S $E(DETLN,33)="Format: "_$S(TYPE="AN":"Alphanumeric",TYPE="N":"Numeric",TYPE="D":"Decimal",TYPE="DT":"Date (YYYYMMDD)",TYPE="TM":"Time (HHMMSS or HHMM)",1:"")
. . S $E(DETLN,62)="Maximum Length: "_$P(ASAP(SEGID,ELMCNT),"^",4)
. . D SETLN^PSOSPMU1("PSOSPML3",DETLN)
. . ; Highlighting fields Requirement, Format and Length
. . D CNTRL^VALM10(LINE,13,10,IOINHI,IOINORM)
. . D CNTRL^VALM10(LINE,41,20,IOINHI,IOINORM)
. . D CNTRL^VALM10(LINE,77,5,IOINHI,IOINORM)
. . F DESCNT=1:1 Q:'$D(ASAP(SEGID,ELMCNT,"DES",DESCNT)) D
. . . D SETLN^PSOSPMU1("PSOSPML3",JUST_ASAP(SEGID,ELMCNT,"DES",DESCNT))
. . ; Field M Expression Value
. . S DETLN="Value: ",MVALUE=""
. . F VALIDX=1:1 Q:'$D(ASAP(SEGID,ELMCNT,"VAL",VALIDX)) D
. . . S MVALUE=MVALUE_ASAP(SEGID,ELMCNT,"VAL",VALIDX)
. . F Q:MVALUE="" D
. . . S $E(DETLN,8)=$E(MVALUE,1,72)
. . . D SETLN^PSOSPMU1("PSOSPML3",DETLN)
. . . D CNTRL^VALM10(LINE,8,72,IOINHI,IOINORM)
. . . S DETLN="",MVALUE=$E(MVALUE,73,999)
. . D SETLN^PSOSPMU1("PSOSPML3"," ")
D SETSEG(ARRAY,LEVEL)
Q
;
HELP ; Listman Help
Q
;
EXIT ;
K ^TMP("PSOSPML3",$J)
Q
;
MEXPRHLP(LEVEL,ELMID) ;MUMPS Expression Help Text
;Input: (r) LEVEL - Level of the Segment where the Data Element is located
; (r) ELMID - Data Element ID ("PHA01", "DSP02", etc.)
N LEVNAM,DIR,X,Y,DIRUT,DTOUT
W !,"This is the argument of a MUMPS SET command that will be used to retrieve the"
W !,"value for the Data Element '",ELMID,"'."
W !,""
W !,"Below are some examples of valid values for this field:"
W !,""
W !,"Null/Blank : Use """" (two quotes) to force a blank value. Another option to"
W !,"----------- force a blank value is to set the Data Element REQUIREMENT field"
W !," to 'N' (NOT USED)."
W !,""
W !,"Fixed Value: Use quotes to force a fixed value for this Data Element."
W !,"----------- Examples: ""AF290303"", ""SMITH"", ""12345"", etc."
W !,""
W !,"MUMPS Code : Use a Mumps expression that can be used as the argument of a SET"
W !,"----------- command. Examples: $P($$SITE^VASITE(),""^"",2)"
W !," $E($$GET1^DIQ(52,RXIEN,.01),1,30)"
W !," $S(FILLIEN>0:""REFILL"",1:""ORIGINAL"")"
W !," $$PHA03^PSOASAP()_""B"""
W !,""
W !,"NOTE: The value for a Standard Definition Data Element is returned by a"
W !," function in the format $$SEGNN^PSOASAP(), where 'SEG' is the 2 or"
W !," 3-character segment identifier and 'NN' is the 2-digit element"
W !," identifier. Examples: $$IS01^PSOASAP(), $$PRE08^PSOASAP(), etc."
;
K DIR S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR
W !,""
S LEVNAM=$P("^PHARMACY HEADER^PATIENT DETAIL^PRESCRIPTION DETAIL^PHARMACY TRAILER^","^",LEVEL)
W !,"The following variables are available at the ",LEVNAM," level for"
W !,"customizing this Data Element:"
W !,""
W !," STATEIEN - State IEN. Pointer to STATE file (#5)."
I LEVEL=1!(LEVEL=6) Q
W !," SITEIEN - Pharmacy Division IEN. Pointer to OUTPATIENT SITE file (#59)."
I LEVEL=2!(LEVEL=5) Q
W !," PATIEN - Patient IEN. Pointer to the PATIENT file (#2)."
I LEVEL=3 Q
W !," RXIEN - Prescription IEN. Pointer to the PRESCRIPTION file (#52)."
W !," DRUGIEN - Drug IEN. Pointer to the DRUG File (#50)"
W !," FILLNUM - Fill Number ('0': Original Fill,'1': Refill #1,'2': Refill #2,"
W !," 'P1': Partial #1,'P2': Partial Fill #2, etc.)"
W !," FILLIEN - Pointer to the REFILL sub-file (#52.1) or PARTIAL sub-file (#52.2)"
W !," ('0': Original, N: Pointer to Refill or Partial fill)"
W !," RPHIEN - Pharmacist IEN. Pointer to NEW PERSON file (#200)."
W !," PREIEN - Prescriber IEN. Pointer to NEW PERSON file (#200)."
W !," RTSREC - Return To Stock Record? ('1': YES / '0': NO)"
Q
;pso*7*772
ACTIONS() ;screen actions on view/edit asap definitions
I '$$VERSIONLOCKED^PSOSPMU0(PSOASVER) Q 1
Q:$G(PKI1)=2 0
N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0
S Y=Y(0,0)
I Y="PSO SPMP3 CUSTOMIZE SEGMENT" Q 0
I Y="PSO SPMP3 CUSTOMIZE DATA ELEMENT" Q 0
I Y="PSO SPMP3 EDIT DELIMETERS" Q 0
I Y="PSO SPMP3 DELETE CUSTOMIZATION" Q 0
Q 1
;
CLONE(PSOVER) ; Is ASAP Version PSOVER a standard version or a custom (copied) version? - PSO*7*772
N CLONE,PSOVERIEN
S CLONE=0
Q:'$L($G(PSOVER)) 0
S PSOVERIEN=$O(^PS(58.4,1,"VER","B",PSOVER,0))
Q:'$G(PSOVERIEN) 0
S CLONE=$L($P($G(^PS(58.4,1,"VER",PSOVERIEN,0)),"^",6))
Q $S($G(CLONE):1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPML3 9124 printed Aug 26, 2025@22:51:10 Page 2
PSOSPML3 ;BIRM/MFR - ASAP Definitions Listman Driver ;09/01/12
+1 ;;7.0;OUTPATIENT PHARMACY;**408,451,625,772**;DEC 1997;Build 105
+2 ;
+3 NEW ASAPVER,VERLST,DIR,DIRUT,DTOUT,X,Y,DIC,VALM,VALMBG,VALMCNT,VALMHDR,VALMBCK,VALMSG,PSOLSTLN
+4 ;
VER ; ASAP Version Prompt
+1 ;adding "B" for Zero Report
WRITE !
SET ASAPVER=$$ASAPVER^PSOSPMU2("A","B",1)
IF ASAPVER["^"!(ASAPVER="")
GOTO EXIT
+2 ;
+3 DO EN(ASAPVER,0)
+4 ;
+5 GOTO VER
+6 ;
EN(PSOASVER,PSOSHOW) ; Entry point
+1 ;Input: (r) PSOASVER - ASAP Version ("3.0", "4.0", etc.)
+2 ; (o) PSOSHOW - 0: Segments Only
+3 ; 1: Segments & Data Elements (ID and Name Only)
+4 ; 2: Segments & Data Elements (All Details)
+5 NEW ASAP
+6 SET PSOSHOW=+$GET(PSOSHOW)
+7 DO EN^VALM("PSO SPMP VIEW ASAP DEFINITION")
+8 DO FULL^VALM1
+9 QUIT
+10 ;
HDR ; - Builds the Header section
+1 ; PSO*7*772 CLONE
NEW STDIEN,VERIEN,HDR,ELMDELIM,SEGTERM,EOSCHR,STDVDLMS,ALLVDLMS,CLONE,HDRLINE,HDR
+2 SET STDVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"S")
+3 SET ALLVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"B")
+4 SET STDIEN=$ORDER(^PS(58.4,"B","STANDARD ASAP DEFINITION",0))
+5 SET VERIEN=$ORDER(^PS(58.4,STDIEN,"VER","B",PSOASVER,0))
+6 ; PSO*7*772 - Cloned ASAP Version
SET CLONE=$PIECE(STDVDLMS,"^",6)
SET HDRLINE=1
+7 ; PSO*7*772 Cloned ASAP Version
SET VALM("TITLE")=" ASAP "_$SELECT('VERIEN!$LENGTH(CLONE):"Custom",1:"Standard")_" Ver "_PSOASVER_$SELECT('VERIEN!$LENGTH(CLONE):"*",1:"")
+8 SET ELMDELIM=$SELECT(PSOASVER="1995":"N/A",1:$PIECE(ALLVDLMS,"^",2))
+9 ; PSO*7*772 Cloned ASAP Version
SET HDR(HDRLINE)="Copied From ASAP Version: "_$SELECT($LENGTH(CLONE):CLONE,1:"N/A")
DO INSTR^VALM1(HDR(HDRLINE),2,HDRLINE+1)
SET HDRLINE=HDRLINE+1
+10 SET HDR(HDRLINE)="Element Delimiter"_$SELECT(($PIECE(STDVDLMS,"^",2)'=""&($PIECE(STDVDLMS,"^",2)'=$PIECE(ALLVDLMS,"^",2))):"*",1:"")_":"_IOINHI_$SELECT(ELMDELIM="":"<NULL>",1:" "_ELMDELIM)_IOINORM
+11 SET SEGTERM=$SELECT(PSOASVER="1995":"N/A",1:$PIECE(ALLVDLMS,"^",3))
+12 ; PSO*7*772 - Denote delimiter customization
SET HDR(HDRLINE)=HDR(HDRLINE)_" Segment Terminator"_$SELECT(($PIECE(STDVDLMS,"^",3)'=""&($PIECE(STDVDLMS,"^",3)'=$PIECE(ALLVDLMS,"^",3))):"*",1:"")_":"_IOINHI_$SELECT(SEGTERM="":"<NULL>",1:" "_SEGTERM)_IOINORM
+13 SET EOSCHR=$SELECT(PSOASVER="1995":"$C(10,13)",1:$PIECE(ALLVDLMS,"^",4))
+14 SET HDR(HDRLINE)=HDR(HDRLINE)_" End Of Line ESC"_$SELECT(($PIECE(STDVDLMS,"^",4)'=""&($PIECE(STDVDLMS,"^",4)'=$PIECE(ALLVDLMS,"^",4))):"*",1:"")_":"_IOINHI_$SELECT(EOSCHR="":"<NULL>",1:" "_EOSCHR)_IOINORM
+15 DO INSTR^VALM1(HDR(HDRLINE),2,HDRLINE+1)
+16 QUIT
+17 ;
INIT ; Builds the Body section
+1 NEW ASAP,LINE,I
+2 ;
+3 KILL ^TMP("PSOSPML3",$JOB)
SET VALMCNT=0
SET LINE=0
+4 FOR I=1:1:1000
DO RESTORE^VALM10(I)
+5 IF PSOASVER="1995"
Begin DoDot:1
+6 DO SETSEG95^PSOSPML4("PSOSPML3","")
SET VALMCNT=LINE
End DoDot:1
+7 IF PSOASVER'="1995"
Begin DoDot:1
+8 DO LOADASAP^PSOSPMU0(PSOASVER,"B",.ASAP)
+9 DO SETSEG("ASAP",0)
SET VALMCNT=LINE
+10 SET VALMSG="Enter ?? for more actions|* Custom Segment/Element"
End DoDot:1
+11 QUIT
+12 ;
+13 ; Note: Recursivity used because of the 'Tree' nature of the ASAP definition
SETSEG(ARRNAM,LEVEL) ; Set list content with the Segment info
+1 ;Input: ARRNAM - Name of the Array containing the ASAP definition
+2 ; LEVEL - Level of the Segment
+3 NEW ARRAY,COLUMN,TYPE,DETLN,SEGID,JUST,I,J,ELMCNT,LSTELM,ELMNAM,MVALUE,SEGLN,LEVNAM,DESCNT,VALIDX
+4 ;
+5 SET PSOSHOW=+$GET(PSOSHOW)
+6 SET ARRAY=$QUERY(@ARRNAM)
IF '+$PIECE(ARRAY,"(",2)
QUIT
+7 SET SEGID=$PIECE(@ARRAY,"^")
SET COLUMN=(($LENGTH(ARRAY,",")-1)*4)
+8 SET JUST=""
if PSOSHOW'=2
SET JUST=$JUSTIFY("",COLUMN)
+9 IF LEVEL'=$PIECE(ASAP(SEGID),"^",6)
Begin DoDot:1
+10 SET LEVEL=$PIECE(ASAP(SEGID),"^",6)
+11 SET LEVNAM=$PIECE("MAIN HEADER^PHARMACY HEADER^PATIENT DETAIL^PRESCRIPTION DETAIL^PHARMACY TRAILER^MAIN TRAILER","^",LEVEL)
+12 DO SETLN^PSOSPMU1("PSOSPML3",JUST_LEVNAM,0,0,0)
+13 DO CNTRL^VALM10(LINE,$LENGTH(JUST)+1,$LENGTH(LEVNAM),IORVON,IORVOFF_IOINORM)
End DoDot:1
+14 SET SEGLN=JUST_$PIECE(ASAP(SEGID),"^")_$SELECT($$CUSSEG^PSOSPMU3(PSOASVER,SEGID):"*",1:"")_" - "_$PIECE(ASAP(SEGID),"^",2)_$SELECT($PIECE(ASAP(SEGID),"^",4)="N":" (Not Used)",1:"")
+15 DO SETLN^PSOSPMU1("PSOSPML3",SEGLN,0,$SELECT(PSOSHOW'=0:1,1:0),$SELECT($PIECE(ASAP(SEGID),"^",4)="N":0,1:1))
+16 SET LSTELM=+$ORDER(ASAP(SEGID,""),-1)
+17 IF PSOSHOW'=0
Begin DoDot:1
+18 FOR ELMCNT=1:1:LSTELM
Begin DoDot:2
+19 if PSOSHOW=1
SET JUST=$JUSTIFY("",COLUMN+$LENGTH(SEGID)+1)
+20 SET ELMNAM=JUST_$PIECE(ASAP(SEGID,ELMCNT),"^")_$SELECT($GET(ASAP(SEGID,ELMCNT,"CUS")):"*",1:"")_" - "_$PIECE(ASAP(SEGID,ELMCNT),"^",2)
+21 SET ELMNAM=ELMNAM_$SELECT((PSOSHOW=1)&($PIECE(ASAP(SEGID,ELMCNT),"^",6)="N"):" (Not Used)",1:"")
+22 DO SETLN^PSOSPMU1("PSOSPML3",ELMNAM,0,0,$SELECT((PSOSHOW=1)&($PIECE(ASAP(SEGID,ELMCNT),"^",6)="N"):0,1:1))
+23 IF PSOSHOW=1
QUIT
+24 SET DETLN=JUST_"Requirement: "_$SELECT($PIECE(ASAP(SEGID,ELMCNT),"^",6)="R":"Required",$PIECE(ASAP(SEGID,ELMCNT),"^",6)="O":"Optional",$PIECE(ASAP(SEGID,ELMCNT),"^",6)="N":"Not Used",1:"")
+25 SET TYPE=$PIECE(ASAP(SEGID,ELMCNT),"^",3)
+26 SET $EXTRACT(DETLN,33)="Format: "_$SELECT(TYPE="AN":"Alphanumeric",TYPE="N":"Numeric",TYPE="D":"Decimal",TYPE="DT":"Date (YYYYMMDD)",TYPE="TM":"Time (HHMMSS or HHMM)",1:"")
+27 SET $EXTRACT(DETLN,62)="Maximum Length: "_$PIECE(ASAP(SEGID,ELMCNT),"^",4)
+28 DO SETLN^PSOSPMU1("PSOSPML3",DETLN)
+29 ; Highlighting fields Requirement, Format and Length
+30 DO CNTRL^VALM10(LINE,13,10,IOINHI,IOINORM)
+31 DO CNTRL^VALM10(LINE,41,20,IOINHI,IOINORM)
+32 DO CNTRL^VALM10(LINE,77,5,IOINHI,IOINORM)
+33 FOR DESCNT=1:1
if '$DATA(ASAP(SEGID,ELMCNT,"DES",DESCNT))
QUIT
Begin DoDot:3
+34 DO SETLN^PSOSPMU1("PSOSPML3",JUST_ASAP(SEGID,ELMCNT,"DES",DESCNT))
End DoDot:3
+35 ; Field M Expression Value
+36 SET DETLN="Value: "
SET MVALUE=""
+37 FOR VALIDX=1:1
if '$DATA(ASAP(SEGID,ELMCNT,"VAL",VALIDX))
QUIT
Begin DoDot:3
+38 SET MVALUE=MVALUE_ASAP(SEGID,ELMCNT,"VAL",VALIDX)
End DoDot:3
+39 FOR
if MVALUE=""
QUIT
Begin DoDot:3
+40 SET $EXTRACT(DETLN,8)=$EXTRACT(MVALUE,1,72)
+41 DO SETLN^PSOSPMU1("PSOSPML3",DETLN)
+42 DO CNTRL^VALM10(LINE,8,72,IOINHI,IOINORM)
+43 SET DETLN=""
SET MVALUE=$EXTRACT(MVALUE,73,999)
End DoDot:3
+44 DO SETLN^PSOSPMU1("PSOSPML3"," ")
End DoDot:2
End DoDot:1
+45 DO SETSEG(ARRAY,LEVEL)
+46 QUIT
+47 ;
HELP ; Listman Help
+1 QUIT
+2 ;
EXIT ;
+1 KILL ^TMP("PSOSPML3",$JOB)
+2 QUIT
+3 ;
MEXPRHLP(LEVEL,ELMID) ;MUMPS Expression Help Text
+1 ;Input: (r) LEVEL - Level of the Segment where the Data Element is located
+2 ; (r) ELMID - Data Element ID ("PHA01", "DSP02", etc.)
+3 NEW LEVNAM,DIR,X,Y,DIRUT,DTOUT
+4 WRITE !,"This is the argument of a MUMPS SET command that will be used to retrieve the"
+5 WRITE !,"value for the Data Element '",ELMID,"'."
+6 WRITE !,""
+7 WRITE !,"Below are some examples of valid values for this field:"
+8 WRITE !,""
+9 WRITE !,"Null/Blank : Use """" (two quotes) to force a blank value. Another option to"
+10 WRITE !,"----------- force a blank value is to set the Data Element REQUIREMENT field"
+11 WRITE !," to 'N' (NOT USED)."
+12 WRITE !,""
+13 WRITE !,"Fixed Value: Use quotes to force a fixed value for this Data Element."
+14 WRITE !,"----------- Examples: ""AF290303"", ""SMITH"", ""12345"", etc."
+15 WRITE !,""
+16 WRITE !,"MUMPS Code : Use a Mumps expression that can be used as the argument of a SET"
+17 WRITE !,"----------- command. Examples: $P($$SITE^VASITE(),""^"",2)"
+18 WRITE !," $E($$GET1^DIQ(52,RXIEN,.01),1,30)"
+19 WRITE !," $S(FILLIEN>0:""REFILL"",1:""ORIGINAL"")"
+20 WRITE !," $$PHA03^PSOASAP()_""B"""
+21 WRITE !,""
+22 WRITE !,"NOTE: The value for a Standard Definition Data Element is returned by a"
+23 WRITE !," function in the format $$SEGNN^PSOASAP(), where 'SEG' is the 2 or"
+24 WRITE !," 3-character segment identifier and 'NN' is the 2-digit element"
+25 WRITE !," identifier. Examples: $$IS01^PSOASAP(), $$PRE08^PSOASAP(), etc."
+26 ;
+27 KILL DIR
SET DIR("A")="Press Return to continue"
SET DIR(0)="E"
DO ^DIR
+28 WRITE !,""
+29 SET LEVNAM=$PIECE("^PHARMACY HEADER^PATIENT DETAIL^PRESCRIPTION DETAIL^PHARMACY TRAILER^","^",LEVEL)
+30 WRITE !,"The following variables are available at the ",LEVNAM," level for"
+31 WRITE !,"customizing this Data Element:"
+32 WRITE !,""
+33 WRITE !," STATEIEN - State IEN. Pointer to STATE file (#5)."
+34 IF LEVEL=1!(LEVEL=6)
QUIT
+35 WRITE !," SITEIEN - Pharmacy Division IEN. Pointer to OUTPATIENT SITE file (#59)."
+36 IF LEVEL=2!(LEVEL=5)
QUIT
+37 WRITE !," PATIEN - Patient IEN. Pointer to the PATIENT file (#2)."
+38 IF LEVEL=3
QUIT
+39 WRITE !," RXIEN - Prescription IEN. Pointer to the PRESCRIPTION file (#52)."
+40 WRITE !," DRUGIEN - Drug IEN. Pointer to the DRUG File (#50)"
+41 WRITE !," FILLNUM - Fill Number ('0': Original Fill,'1': Refill #1,'2': Refill #2,"
+42 WRITE !," 'P1': Partial #1,'P2': Partial Fill #2, etc.)"
+43 WRITE !," FILLIEN - Pointer to the REFILL sub-file (#52.1) or PARTIAL sub-file (#52.2)"
+44 WRITE !," ('0': Original, N: Pointer to Refill or Partial fill)"
+45 WRITE !," RPHIEN - Pharmacist IEN. Pointer to NEW PERSON file (#200)."
+46 WRITE !," PREIEN - Prescriber IEN. Pointer to NEW PERSON file (#200)."
+47 WRITE !," RTSREC - Return To Stock Record? ('1': YES / '0': NO)"
+48 QUIT
+49 ;pso*7*772
ACTIONS() ;screen actions on view/edit asap definitions
+1 IF '$$VERSIONLOCKED^PSOSPMU0(PSOASVER)
QUIT 1
+2 if $GET(PKI1)=2
QUIT 0
+3 NEW DIC,X,Y
KILL DIC,Y
SET DIC="^ORD(101,"_DA(1)_",10,"
SET X=DA
SET DIC(0)="ZN"
DO ^DIC
if Y<0
QUIT 0
+4 SET Y=Y(0,0)
+5 IF Y="PSO SPMP3 CUSTOMIZE SEGMENT"
QUIT 0
+6 IF Y="PSO SPMP3 CUSTOMIZE DATA ELEMENT"
QUIT 0
+7 IF Y="PSO SPMP3 EDIT DELIMETERS"
QUIT 0
+8 IF Y="PSO SPMP3 DELETE CUSTOMIZATION"
QUIT 0
+9 QUIT 1
+10 ;
CLONE(PSOVER) ; Is ASAP Version PSOVER a standard version or a custom (copied) version? - PSO*7*772
+1 NEW CLONE,PSOVERIEN
+2 SET CLONE=0
+3 if '$LENGTH($GET(PSOVER))
QUIT 0
+4 SET PSOVERIEN=$ORDER(^PS(58.4,1,"VER","B",PSOVER,0))
+5 if '$GET(PSOVERIEN)
QUIT 0
+6 SET CLONE=$LENGTH($PIECE($GET(^PS(58.4,1,"VER",PSOVERIEN,0)),"^",6))
+7 QUIT $SELECT($GET(CLONE):1,1:0)
