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

PSOSPML3.m

Go to the documentation of this file.
  1. PSOSPML3 ;BIRM/MFR - ASAP Definitions Listman Driver ;09/01/12
  1. ;;7.0;OUTPATIENT PHARMACY;**408,451,625**;DEC 1997;Build 42
  1. ;
  1. N ASAPVER,VERLST,DIR,DIRUT,DTOUT,X,Y,DIC,VALM,VALMBG,VALMCNT,VALMHDR,VALMBCK,VALMSG,PSOLSTLN
  1. ;
  1. VER ; ASAP Version Prompt
  1. W ! S ASAPVER=$$ASAPVER^PSOSPMU2("A","B",1) I ASAPVER["^"!(ASAPVER="") G EXIT ;adding "B" for Zero Report
  1. ;
  1. D EN(ASAPVER,0)
  1. ;
  1. G VER
  1. ;
  1. EN(PSOASVER,PSOSHOW) ; Entry point
  1. ;Input: (r) PSOASVER - ASAP Version ("3.0", "4.0", etc.)
  1. ; (o) PSOSHOW - 0: Segments Only
  1. ; 1: Segments & Data Elements (ID and Name Only)
  1. ; 2: Segments & Data Elements (All Details)
  1. N ASAP
  1. S PSOSHOW=+$G(PSOSHOW)
  1. D EN^VALM("PSO SPMP VIEW ASAP DEFINITION")
  1. D FULL^VALM1
  1. Q
  1. ;
  1. HDR ; - Builds the Header section
  1. N STDIEN,VERIEN,HDR,ELMDELIM,SEGTERM,EOSCHR,STDVDLMS,ALLVDLMS
  1. S STDVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"S")
  1. S ALLVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"B")
  1. S STDIEN=$O(^PS(58.4,"B","STANDARD ASAP DEFINITION",0))
  1. S VERIEN=$O(^PS(58.4,STDIEN,"VER","B",PSOASVER,0))
  1. S VALM("TITLE")=" ASAP "_$S('VERIEN:"Custom",1:"Standard")_" Version "_PSOASVER_$S('VERIEN:"*",1:"")
  1. S ELMDELIM=$S(PSOASVER="1995":"N/A",1:$P(ALLVDLMS,"^",2))
  1. S HDR="Element Delimiter"_$S(($P(STDVDLMS,"^",2)'=""&($P(STDVDLMS,"^",2)'=$P(ALLVDLMS,"^",2))):"*",1:"")_":"_IOINHI_$S(ELMDELIM="":"<NULL>",1:" "_ELMDELIM)_IOINORM
  1. S SEGTERM=$S(PSOASVER="1995":"N/A",1:$P(ALLVDLMS,"^",3))
  1. S HDR=HDR_" Segment Terminator"_$S(($P(STDVDLMS,"^",3)'=""&($P(STDVDLMS,"^",3)'=$P(ALLVDLMS,"^",3))):"*",1:"")_":"_IOINHI_$S(SEGTERM="":"<NULL>",1:" "_SEGTERM)_IOINORM
  1. S EOSCHR=$S(PSOASVER="1995":"$C(10,13)",1:$P(ALLVDLMS,"^",4))
  1. S HDR=HDR_" End Of Line ESC"_$S(($P(STDVDLMS,"^",4)'=""&($P(STDVDLMS,"^",4)'=$P(ALLVDLMS,"^",4))):"*",1:"")_":"_IOINHI_$S(EOSCHR="":"<NULL>",1:" "_EOSCHR)_IOINORM
  1. D INSTR^VALM1(HDR,1,2)
  1. Q
  1. ;
  1. INIT ; Builds the Body section
  1. N ASAP,LINE,I
  1. ;
  1. K ^TMP("PSOSPML3",$J) S VALMCNT=0,LINE=0
  1. F I=1:1:1000 D RESTORE^VALM10(I)
  1. I PSOASVER="1995" D
  1. . D SETSEG95^PSOSPML4("PSOSPML3","") S VALMCNT=LINE
  1. I PSOASVER'="1995" D
  1. . D LOADASAP^PSOSPMU0(PSOASVER,"B",.ASAP)
  1. . D SETSEG("ASAP",0) S VALMCNT=LINE
  1. . S VALMSG="Enter ?? for more actions|* Custom Segment/Element"
  1. Q
  1. ;
  1. ; Note: Recursivity used because of the 'Tree' nature of the ASAP definition
  1. SETSEG(ARRNAM,LEVEL) ; Set list content with the Segment info
  1. ;Input: ARRNAM - Name of the Array containing the ASAP definition
  1. ; LEVEL - Level of the Segment
  1. N ARRAY,COLUMN,TYPE,DETLN,SEGID,JUST,I,J,ELMCNT,LSTELM,ELMNAM,MVALUE,SEGLN,LEVNAM,DESCNT,VALIDX
  1. ;
  1. S PSOSHOW=+$G(PSOSHOW)
  1. S ARRAY=$Q(@ARRNAM) I '+$P(ARRAY,"(",2) Q
  1. S SEGID=$P(@ARRAY,"^"),COLUMN=(($L(ARRAY,",")-1)*4)
  1. S JUST="" S:PSOSHOW'=2 JUST=$J("",COLUMN)
  1. I LEVEL'=$P(ASAP(SEGID),"^",6) D
  1. . S LEVEL=$P(ASAP(SEGID),"^",6)
  1. . S LEVNAM=$P("MAIN HEADER^PHARMACY HEADER^PATIENT DETAIL^PRESCRIPTION DETAIL^PHARMACY TRAILER^MAIN TRAILER","^",LEVEL)
  1. . D SETLN^PSOSPMU1("PSOSPML3",JUST_LEVNAM,0,0,0)
  1. . D CNTRL^VALM10(LINE,$L(JUST)+1,$L(LEVNAM),IORVON,IORVOFF_IOINORM)
  1. 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:"")
  1. D SETLN^PSOSPMU1("PSOSPML3",SEGLN,0,$S(PSOSHOW'=0:1,1:0),$S($P(ASAP(SEGID),"^",4)="N":0,1:1))
  1. S LSTELM=+$O(ASAP(SEGID,""),-1)
  1. I PSOSHOW'=0 D
  1. . F ELMCNT=1:1:LSTELM D
  1. . . S:PSOSHOW=1 JUST=$J("",COLUMN+$L(SEGID)+1)
  1. . . S ELMNAM=JUST_$P(ASAP(SEGID,ELMCNT),"^")_$S($G(ASAP(SEGID,ELMCNT,"CUS")):"*",1:"")_" - "_$P(ASAP(SEGID,ELMCNT),"^",2)
  1. . . S ELMNAM=ELMNAM_$S((PSOSHOW=1)&($P(ASAP(SEGID,ELMCNT),"^",6)="N"):" (Not Used)",1:"")
  1. . . D SETLN^PSOSPMU1("PSOSPML3",ELMNAM,0,0,$S((PSOSHOW=1)&($P(ASAP(SEGID,ELMCNT),"^",6)="N"):0,1:1))
  1. . . I PSOSHOW=1 Q
  1. . . 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:"")
  1. . . S TYPE=$P(ASAP(SEGID,ELMCNT),"^",3)
  1. . . 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:"")
  1. . . S $E(DETLN,62)="Maximum Length: "_$P(ASAP(SEGID,ELMCNT),"^",4)
  1. . . D SETLN^PSOSPMU1("PSOSPML3",DETLN)
  1. . . ; Highlighting fields Requirement, Format and Length
  1. . . D CNTRL^VALM10(LINE,13,10,IOINHI,IOINORM)
  1. . . D CNTRL^VALM10(LINE,41,20,IOINHI,IOINORM)
  1. . . D CNTRL^VALM10(LINE,77,5,IOINHI,IOINORM)
  1. . . F DESCNT=1:1 Q:'$D(ASAP(SEGID,ELMCNT,"DES",DESCNT)) D
  1. . . . D SETLN^PSOSPMU1("PSOSPML3",JUST_ASAP(SEGID,ELMCNT,"DES",DESCNT))
  1. . . ; Field M Expression Value
  1. . . S DETLN="Value: ",MVALUE=""
  1. . . F VALIDX=1:1 Q:'$D(ASAP(SEGID,ELMCNT,"VAL",VALIDX)) D
  1. . . . S MVALUE=MVALUE_ASAP(SEGID,ELMCNT,"VAL",VALIDX)
  1. . . F Q:MVALUE="" D
  1. . . . S $E(DETLN,8)=$E(MVALUE,1,72)
  1. . . . D SETLN^PSOSPMU1("PSOSPML3",DETLN)
  1. . . . D CNTRL^VALM10(LINE,8,72,IOINHI,IOINORM)
  1. . . . S DETLN="",MVALUE=$E(MVALUE,73,999)
  1. . . D SETLN^PSOSPMU1("PSOSPML3"," ")
  1. D SETSEG(ARRAY,LEVEL)
  1. Q
  1. ;
  1. HELP ; Listman Help
  1. Q
  1. ;
  1. EXIT ;
  1. K ^TMP("PSOSPML3",$J)
  1. Q
  1. ;
  1. MEXPRHLP(LEVEL,ELMID) ;MUMPS Expression Help Text
  1. ;Input: (r) LEVEL - Level of the Segment where the Data Element is located
  1. ; (r) ELMID - Data Element ID ("PHA01", "DSP02", etc.)
  1. N LEVNAM,DIR,X,Y,DIRUT,DTOUT
  1. W !,"This is the argument of a MUMPS SET command that will be used to retrieve the"
  1. W !,"value for the Data Element '",ELMID,"'."
  1. W !,""
  1. W !,"Below are some examples of valid values for this field:"
  1. W !,""
  1. W !,"Null/Blank : Use """" (two quotes) to force a blank value. Another option to"
  1. W !,"----------- force a blank value is to set the Data Element REQUIREMENT field"
  1. W !," to 'N' (NOT USED)."
  1. W !,""
  1. W !,"Fixed Value: Use quotes to force a fixed value for this Data Element."
  1. W !,"----------- Examples: ""AF290303"", ""SMITH"", ""12345"", etc."
  1. W !,""
  1. W !,"MUMPS Code : Use a Mumps expression that can be used as the argument of a SET"
  1. W !,"----------- command. Examples: $P($$SITE^VASITE(),""^"",2)"
  1. W !," $E($$GET1^DIQ(52,RXIEN,.01),1,30)"
  1. W !," $S(FILLIEN>0:""REFILL"",1:""ORIGINAL"")"
  1. W !," $$PHA03^PSOASAP()_""B"""
  1. W !,""
  1. W !,"NOTE: The value for a Standard Definition Data Element is returned by a"
  1. W !," function in the format $$SEGNN^PSOASAP(), where 'SEG' is the 2 or"
  1. W !," 3-character segment identifier and 'NN' is the 2-digit element"
  1. W !," identifier. Examples: $$IS01^PSOASAP(), $$PRE08^PSOASAP(), etc."
  1. ;
  1. K DIR S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR
  1. W !,""
  1. S LEVNAM=$P("^PHARMACY HEADER^PATIENT DETAIL^PRESCRIPTION DETAIL^PHARMACY TRAILER^","^",LEVEL)
  1. W !,"The following variables are available at the ",LEVNAM," level for"
  1. W !,"customizing this Data Element:"
  1. W !,""
  1. W !," STATEIEN - State IEN. Pointer to STATE file (#5)."
  1. I LEVEL=1!(LEVEL=6) Q
  1. W !," SITEIEN - Pharmacy Division IEN. Pointer to OUTPATIENT SITE file (#59)."
  1. I LEVEL=2!(LEVEL=5) Q
  1. W !," PATIEN - Patient IEN. Pointer to the PATIENT file (#2)."
  1. I LEVEL=3 Q
  1. W !," RXIEN - Prescription IEN. Pointer to the PRESCRIPTION file (#52)."
  1. W !," DRUGIEN - Drug IEN. Pointer to the DRUG File (#50)"
  1. W !," FILLNUM - Fill Number ('0': Original Fill,'1': Refill #1,'2': Refill #2,"
  1. W !," 'P1': Partial #1,'P2': Partial Fill #2, etc.)"
  1. W !," FILLIEN - Pointer to the REFILL sub-file (#52.1) or PARTIAL sub-file (#52.2)"
  1. W !," ('0': Original, N: Pointer to Refill or Partial fill)"
  1. W !," RPHIEN - Pharmacist IEN. Pointer to NEW PERSON file (#200)."
  1. W !," PREIEN - Prescriber IEN. Pointer to NEW PERSON file (#200)."
  1. W !," RTSREC - Return To Stock Record? ('1': YES / '0': NO)"
  1. Q