PSOSPMU0 ;BIRM/MFR - State Prescription Monitoring Program - Load ASAP Definition Utility ;10/07/12
;;7.0;OUTPATIENT PHARMACY;**451,625,772,797**;DEC 1997;Build 7
;
LOADASAP(VERSION,DEFTYPE,ASARRAY) ; Loads the ASAP definition array for the specific Version
; Input: (r) VERSION - ASAP Version (3.0, 4.0, 4.1, 4.2)
; (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, B: Both)
;Output: ASARRAY - Array containing the ASAP Hierarchical Segment Structure/ASAP Elements Definition
;
N ASAPDEF,FILEIEN,VER,VERIEN,SEGIEN,SEGNAM,ELMIEN,ELM0,ELMPOS,STAIEN,I
;
I $G(VERSION)="" Q
K ASARRAY,SEGINFO
D SEGTREE(VERSION,DEFTYPE,"ASARRAY")
F ASAPDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION" D
. I ASAPDEF="STANDARD ASAP DEFINITION",DEFTYPE="C" Q
. I ASAPDEF="CUSTOM ASAP DEFINITION",DEFTYPE="S" Q
. S FILEIEN=$O(^PS(58.4,"B",ASAPDEF,0))
. F VER="ALL",VERSION D
. . I VER="ALL",VERSION="4.1Z"!(VERSION="4.2Z")!(VERSION="4.2AZ")!(VERSION="4.2BZ")!(VERSION="5.0Z") Q ;Zero Report doesn't load "ALL"
. . ; - Don't want to load default (ALL) definitions for entirely cloned ASAP versions
. . I ASAPDEF="STANDARD ASAP DEFINITION",'$D(^PS(58.4,FILEIEN,"VER","B",VERSION)) Q
. . S VERIEN=$O(^PS(58.4,FILEIEN,"VER","B",VER,0)) I 'VERIEN Q
. . I VER'="ALL" S ASARRAY=$G(^PS(58.4,FILEIEN,"VER",VERIEN,0))
. . I VER="ALL",$$VERZERO^PSOSPMU0(PSOASVER) Q ; 772 - Don't load "ALL" if ZERO REPORT ASAP VERSION (#.05) indicates Zero Report
. . S SEGIEN=0
. . F S SEGIEN=$O(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN)) Q:'SEGIEN D
. . . S SEGNAM=$P($G(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,0)),"^")
. . . S ELMIEN=0
. . . F S ELMIEN=$O(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN)) Q:'ELMIEN D
. . . . S ELM0=$G(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,0))
. . . . S ELMPOS=$P(ELM0,"^",5)
. . . . ; - Retrieving Data Element Definition
. . . . S ASARRAY(SEGNAM,ELMPOS)=ELM0
. . . . ; - Data Element Description
. . . . K ASARRAY(SEGNAM,ELMPOS,"DES")
. . . . F I=1:1 Q:'$D(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"DES",I)) D
. . . . . S ASARRAY(SEGNAM,ELMPOS,"DES",I)=$G(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"DES",I,0))
. . . . ; - Data Element Value - Mumps SET Command Argument
. . . . K ASARRAY(SEGNAM,ELMPOS,"VAL")
. . . . F I=1:1 Q:'$D(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"VAL",I)) D
. . . . . S ASARRAY(SEGNAM,ELMPOS,"VAL",I)=$G(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"VAL",I,0))
. . . . ; - Customized ASAP Data Element Flagging
. . . . I ASAPDEF="CUSTOM ASAP DEFINITION" D
. . . . . S ASARRAY(SEGNAM,ELMPOS,"CUS")=1
Q
;
SEGTREE(VERSION,DEFTYPE,ARRAY) ; Retrieve Hierarchical (Tree) Segement Positioning Information for each ASAP Version
; Input: (r) VERSION - ASAP Version (e.g., "3.0", "4.2", etc.)
; (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, B: Both)
;Output: ARRAY - Array containing Segment Hierarchically formatted (tree)
; Example: ARRAY(1)="TH"
; ARRAY(1,1)="IS"
; ARRAY(1,1,1)="PHA"
; ARRAY(1,1,1,1)="PAT"
; ARRAY(1,1,1,1,2)="DSP"
; ...
; ARRAY(1,1,2)="TP"
; ARRAY(2)="TT"
N ASAPDEF,FILEIEN,VER,VERIEN,SEGIEN,SEG0,PARSEG,SEGPOS,SEGINFO
; Retrieving information about each Segment
K @ARRAY
F ASAPDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION" D
. I ASAPDEF="STANDARD ASAP DEFINITION",DEFTYPE="C" Q
. I ASAPDEF="CUSTOM ASAP DEFINITION",DEFTYPE="S" Q
. S FILEIEN=$O(^PS(58.4,"B",ASAPDEF,0))
. F VER="ALL",VERSION D
. . ; - Prevent loading default (ALL) definitions for entirely cloned ASAP versions
. . I ASAPDEF="STANDARD ASAP DEFINITION",'$D(^PS(58.4,FILEIEN,"VER","B",VERSION)) Q
. . S VERIEN=$O(^PS(58.4,FILEIEN,"VER","B",VER,0)) I 'VERIEN Q
. . S SEGIEN=0
. . F S SEGIEN=$O(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN)) Q:'SEGIEN D
. . . S SEG0=$G(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,0))
. . . S PARSEG=$P(SEG0,"^",3)
. . . S SEGPOS=+$P(SEG0,"^",5)
. . . S SEGINFO($P(SEG0,"^"))=PARSEG_"^"_SEGPOS
. . . S @ARRAY@($P(SEG0,"^"))=SEG0
; Building the Segment Tree
D BLDTREE("",.SEGINFO,ARRAY)
Q
;
BLDTREE(SEG,SEGINFO,ARRAY) ; Build the ASAP Segment Tree (Recursivity Used)
; Input: SEG - Initial Segment (Usually "" to build from the top of the tree)
; SEGINFO - Segment Information Array (Parent & Position)
;Output: ARRAY - ASAP Segment Tree (See above for format)
N SEGNAM
S SEGNAM=""
F S SEGNAM=$O(SEGINFO(SEGNAM)) Q:SEGNAM="" D
. I $P(SEGINFO(SEGNAM),"^")'=SEG Q
. S @ARRAY@($P(SEGINFO(SEGNAM),"^",2))=SEGNAM
. D BLDTREE(SEGNAM,.SEGINFO,$Q(@ARRAY))
Q
;
VERLIST(DEFTYPE,REGZERO,ARRAY) ; Return a list of ASAP Versions ;Zero Report adding REGZERO
; Input: (r) DEFTYPE - ASAP Definition Type (D: Default Only; C: Customized Only, F: Fully Customized Only,
; A: All. A combination is also allowed, e.g., "CF")
; (r) REGZERO - Regular or Zero Report or Both ASAP Definitions (R: Regular Only;
; Z: Zero Report Only; B: Both)
;Output: ARRAY - ASAP Version List (ARRAY("3.0")="S", ARRAY("4.0")="S", etc...)
N STDIEN,CUSIEN,VERSION,CLONE ; Standard CLONE PSO*7*772
N VER,ZFLG ;adding Zero Report flag
K ARRAY S CLONE="" ; Standard CLONE PSO*7*772
S STDIEN=$O(^PS(58.4,"B","STANDARD ASAP DEFINITION",0))
S CUSIEN=$O(^PS(58.4,"B","CUSTOM ASAP DEFINITION",0))
I DEFTYPE["A"!(DEFTYPE["S") D
. S VERSION="" F S VERSION=$O(^PS(58.4,STDIEN,"VER","B",VERSION)) Q:VERSION="" D
. . I VERSION="ALL" Q
. . S VER=$O(^PS(58.4,STDIEN,"VER","B",VERSION,0)) S ZFLG=$P($G(^PS(58.4,STDIEN,"VER",VER,0)),"^",5)
. . I REGZERO["Z",'ZFLG Q ;Zero ASAP only
. . S CLONE=$$CLONE^PSOSPML3(VERSION) ; PSO*7*772
. . I REGZERO["R",ZFLG Q ;ASAP only
. . I REGZERO["B",ZFLG S ARRAY(VERSION_" ")="SZ",ARRAY(VERSION_" ","CLONE")=+$G(CLONE) Q ;both ASAP and Zero ASAP
. . S ARRAY(VERSION_" ")="S"
. . S ARRAY(VERSION_" ","CLONE")=+$G(CLONE) ; PSO*7*772
I DEFTYPE["A"!(DEFTYPE["C")!(DEFTYPE["F") D
. S VERSION="" F S VERSION=$O(^PS(58.4,CUSIEN,"VER","B",VERSION)) Q:VERSION="" D
. . I $D(ARRAY(VERSION_" ")) Q ;if customized Zero Report
. . S VER=$O(^PS(58.4,CUSIEN,"VER","B",VERSION,0)) S ZFLG=$P($G(^PS(58.4,CUSIEN,"VER",VER,0)),"^",5)
. . I REGZERO["Z",'ZFLG Q ;Zero ASAP only
. . I REGZERO["R",ZFLG Q ;ASAP only
. . I DEFTYPE["A"!(DEFTYPE["C"),$D(^PS(58.4,STDIEN,"VER","B",VERSION)) S ARRAY(VERSION_" ")="C"
. . I DEFTYPE["A"!(DEFTYPE["C"),$D(^PS(58.4,STDIEN,"VER","B",VERSION)),ZFLG S ARRAY(VERSION_" ")="CZ" ;Zero Rpt
. . I DEFTYPE["A"!(DEFTYPE["F"),'$D(^PS(58.4,STDIEN,"VER","B",VERSION)) S ARRAY(VERSION_" ")="F"
. . I DEFTYPE["A"!(DEFTYPE["F"),'$D(^PS(58.4,STDIEN,"VER","B",VERSION)),ZFLG S ARRAY(VERSION_" ")="FZ" ;Zero Rpt
Q
;
VERDATA(VERSION,DEFTYPE) ; Returns the ASAP Version fields
; Input: (r) VERSION - ASAP Version (e.g., "3.0", "4.2", etc.)
; (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, B: Both)
;Output: VERDATA - Sub-file #58.4001 0 node: "Version^Data Element Delimiter Char^Segment Terminator Char^..."
N VERDATA,ASAPDEF,ASDEFIEN,VERIEN
S VERDATA=""
F ASAPDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION" D
. I ASAPDEF="STANDARD ASAP DEFINITION",DEFTYPE="C" Q
. I ASAPDEF="CUSTOM ASAP DEFINITION",DEFTYPE="S" Q
. S ASDEFIEN=$O(^PS(58.4,"B",ASAPDEF,0)) I 'ASDEFIEN Q
. S VERIEN=$O(^PS(58.4,ASDEFIEN,"VER","B",VERSION,0)) I 'VERIEN Q
. S VERDATA=$G(^PS(58.4,ASDEFIEN,"VER",VERIEN,0))
Q VERDATA
;
VERZERO(PSOASVER) ; 772 - Is Version PSOASVER a Zero Report?
N VERIEN,ZERO
Q:'$G(PSOASVER) 0
S VERIEN=$O(^PS(58.4,1,"VER","B",PSOASVER,0)) Q:'VERIEN 0
S ZERO=$P($G(^PS(58.4,1,"VER",VERIEN,0)),"^",5) Q:ZERO 1
Q 0
;
;
VERSIONLOCKED(VERSEL) ; PSO*7*772
; check to see if VERSION is locked
; input - VERSEL = VERSION the end-user selected when
; executing the View/Edit ASAP Definitions option (e.g., 5.0)
N PSOASDEF,PSOASIEN,PSOVER,PSOVERIEN,RETURN
S (PSOVER,RETURN)=0
F PSOASDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION" D
. Q:RETURN ; already found the version
. S PSOASIEN=$O(^PS(58.4,"B",PSOASDEF,0))
. F S PSOVER=$O(^PS(58.4,PSOASIEN,"VER","B",PSOVER)) Q:PSOVER="" D
. . I VERSEL=PSOVER S PSOVERIEN=$O(^PS(58.4,PSOASIEN,"VER","B",PSOVER,0)) D
. . . I +$$GET1^DIQ(58.4001,PSOVERIEN_","_PSOASIEN,.07,"I") S RETURN=1
Q RETURN
;
RESETELM(CUSIEN,VERIEN,SEGIEN,SEGID,ELMIEN,ELMID,ELMPOS,CUSASAP,STDASAP) ; Reset (Remove Customizations from) Data Element
; CUSIEN- IEN of the CUSTOM record name from the SPMP ASAP RECORD DEFINITIONS file (#58.4)
; VERIEN - IEN of the ASAP version from the VERSION sub-file (#58.4001) of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
; SEGIEN - IEN of the segment from the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
; SEGID - NAME (#.01) field value of the segment in the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
; ELMIEN - IEN of the element from the DATA ELEMENT sub-file (#58.400111) of the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
; ELMID - NAME (#.01) field value of the element in the DATA ELEMENT sub-file (#58.400111) of the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
; ELMPOS - Position of the Data Element within the segment
; CUSASAP - Array of customizations from the CUSTOM ASAP DEFINITION node of the SPMP ASAP RECORD DEFINITIONS file (#58.4).
; STDASAP - Array of non-customized ASAP definition from the STANDARD ASAP DEFINITION node of the SPMP ASAP RECORD DEFINITIONS file (#58.4).
;
N DIK,DA
S DIK="^PS(58.4,"_CUSIEN_",""VER"","_VERIEN_",""SEG"","_SEGIEN_",""DAT"","
S DA(3)=CUSIEN,DA(2)=VERIEN,DA(1)=SEGIEN,DA=ELMIEN D ^DIK I $G(ELMPOS) I $P($G(CUSASAP(SEGID,ELMPOS)),"^")=ELMID K CUSASAP(SEGID,ELMPOS)
I '$O(CUSASAP(SEGID,"")),($G(CUSASAP(SEGID))=$G(STDASAP(SEGID))) D ; No customized elements in this segment, no customizations in this segment, remove custom segment
. S DIK="^PS(58.4,"_CUSIEN_",""VER"","_VERIEN_",""SEG"","
. S DA(2)=CUSIEN,DA(1)=VERIEN,DA=SEGIEN D ^DIK
. K CUSASAP(SEGID)
Q
;
ELMDIFF(SEGID,ELMPOS,ELMDATA,EDEMAXL,EDEREQ,MEXPR,ASAPAR) ; Compare NEW and OLD arrays
N EDENAME,EDEFMT,EDESLINE,EDESDIFF,ASAPLINE
I '$L($G(SEGID)) Q 1
I '$L($G(ELMPOS)) Q 1
I '$L($G(ELMDATA)) Q 1
S EDENAME=$P(ELMDATA,"^",2),EDEFMT=$P(ELMDATA,"^",3)
I $G(EDENAME)'=$P(ASAPAR(SEGID,ELMPOS),"^",2) Q 1 ; Element name was changed
I $G(EDEFMT)'=$P(ASAPAR(SEGID,ELMPOS),"^",3) Q 1 ; Data format was changed
I $G(EDEMAXL)'=$P(ASAPAR(SEGID,ELMPOS),"^",4) Q 1 ; Max length was changed
I $G(EDEREQ)'=$P(ASAPAR(SEGID,ELMPOS),"^",6) Q 1 ; Requirement was changed
I $G(MEXPR)'=$G(ASAPAR(SEGID,ELMPOS,"VAL",1)) Q 1 ; (Return) Value was changed
;
; Number of lines of edited Description text
S EDESLINE="" S EDESLINE=$O(ELMDATA("DES",EDESLINE),-1)
;
; Number of lines of comparison array Description text
S ASAPLINE="" S ASAPLINE=$O(ASAPAR(SEGID,ELMPOS,"DES",ASAPLINE),-1)
;
; Number of lines of Description text has changed, that's a change
I ASAPLINE'=EDESLINE Q 1
;
; If same number of lines in Description, check for changes
S EDESLINE=0 F S EDESLINE=$O(ELMDATA("DES",EDESLINE)) Q:'EDESLINE!$G(EDESDIFF) D
. I ELMDATA("DES",EDESLINE)'=$G(ASAPAR(SEGID,ELMPOS,"DES",+$G(EDESLINE))) S EDESDIFF=1
Q:$G(EDESDIFF) 1 ; Description has changed
Q 0 ; Nothing has changed
;
ASKMEXPR(LEVEL,ELMID,MAXLEN,DEFAULT) ; Prompt for M SET Expression
;Input: (r) LEVEL - Level of the Segment where the Data Element is located
; (r) ELMID - Data Element ID ("PHA01", "DSP02", etc.)
; (r) MAXLEN - Element ID value Maximum Length
; (o) DEFAULT - Default value
;Output: M SET Expression or "^"
N ASKMEXPR,DONE,ERROR
S DONE=0,X=$G(DEFAULT)
F D I DONE Q
. S X=$G(DEFAULT) W !,"M SET EXPRESSION: "_$S(X'="":X_"// ",1:"")
. R X:DTIME S:X="" X=$G(DEFAULT) I '$T!(X="^") S ASKMEXPR="^",DONE=1 Q
. I X["?" W ! D MEXPRHLP^PSOSPML3(LEVEL,ELMID) W ! Q
. I '$$VALID^PSOSPMU3(PSOASVER,X) W !,$P($$VALID^PSOSPMU3(PSOASVER,X),"^",2),$C(7),! Q
. I '$$CHKVAR^PSOSPMU3(LEVEL,X) Q
. D CHKCODE^PSOSPMU3(LEVEL,X,.ERROR) I ERROR Q
. I $E(X,1)="""",$E(X,$L(X))="""",$E(X,2,$L(X)-1)'["""",$L(X)-2>MAXLEN D Q
. . W !,"The length cannot be longer than the maximum (",MAXLEN,").",$C(7),!
. S ASKMEXPR=X,DONE=1
Q ASKMEXPR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMU0 12924 printed Jan 29, 2026@15:34:10 Page 2
PSOSPMU0 ;BIRM/MFR - State Prescription Monitoring Program - Load ASAP Definition Utility ;10/07/12
+1 ;;7.0;OUTPATIENT PHARMACY;**451,625,772,797**;DEC 1997;Build 7
+2 ;
LOADASAP(VERSION,DEFTYPE,ASARRAY) ; Loads the ASAP definition array for the specific Version
+1 ; Input: (r) VERSION - ASAP Version (3.0, 4.0, 4.1, 4.2)
+2 ; (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, B: Both)
+3 ;Output: ASARRAY - Array containing the ASAP Hierarchical Segment Structure/ASAP Elements Definition
+4 ;
+5 NEW ASAPDEF,FILEIEN,VER,VERIEN,SEGIEN,SEGNAM,ELMIEN,ELM0,ELMPOS,STAIEN,I
+6 ;
+7 IF $GET(VERSION)=""
QUIT
+8 KILL ASARRAY,SEGINFO
+9 DO SEGTREE(VERSION,DEFTYPE,"ASARRAY")
+10 FOR ASAPDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION"
Begin DoDot:1
+11 IF ASAPDEF="STANDARD ASAP DEFINITION"
IF DEFTYPE="C"
QUIT
+12 IF ASAPDEF="CUSTOM ASAP DEFINITION"
IF DEFTYPE="S"
QUIT
+13 SET FILEIEN=$ORDER(^PS(58.4,"B",ASAPDEF,0))
+14 FOR VER="ALL",VERSION
Begin DoDot:2
+15 ;Zero Report doesn't load "ALL"
IF VER="ALL"
IF VERSION="4.1Z"!(VERSION="4.2Z")!(VERSION="4.2AZ")!(VERSION="4.2BZ")!(VERSION="5.0Z")
QUIT
+16 ; - Don't want to load default (ALL) definitions for entirely cloned ASAP versions
+17 IF ASAPDEF="STANDARD ASAP DEFINITION"
IF '$DATA(^PS(58.4,FILEIEN,"VER","B",VERSION))
QUIT
+18 SET VERIEN=$ORDER(^PS(58.4,FILEIEN,"VER","B",VER,0))
IF 'VERIEN
QUIT
+19 IF VER'="ALL"
SET ASARRAY=$GET(^PS(58.4,FILEIEN,"VER",VERIEN,0))
+20 ; 772 - Don't load "ALL" if ZERO REPORT ASAP VERSION (#.05) indicates Zero Report
IF VER="ALL"
IF $$VERZERO^PSOSPMU0(PSOASVER)
QUIT
+21 SET SEGIEN=0
+22 FOR
SET SEGIEN=$ORDER(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN))
if 'SEGIEN
QUIT
Begin DoDot:3
+23 SET SEGNAM=$PIECE($GET(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,0)),"^")
+24 SET ELMIEN=0
+25 FOR
SET ELMIEN=$ORDER(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN))
if 'ELMIEN
QUIT
Begin DoDot:4
+26 SET ELM0=$GET(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,0))
+27 SET ELMPOS=$PIECE(ELM0,"^",5)
+28 ; - Retrieving Data Element Definition
+29 SET ASARRAY(SEGNAM,ELMPOS)=ELM0
+30 ; - Data Element Description
+31 KILL ASARRAY(SEGNAM,ELMPOS,"DES")
+32 FOR I=1:1
if '$DATA(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"DES",I))
QUIT
Begin DoDot:5
+33 SET ASARRAY(SEGNAM,ELMPOS,"DES",I)=$GET(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"DES",I,0))
End DoDot:5
+34 ; - Data Element Value - Mumps SET Command Argument
+35 KILL ASARRAY(SEGNAM,ELMPOS,"VAL")
+36 FOR I=1:1
if '$DATA(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"VAL",I))
QUIT
Begin DoDot:5
+37 SET ASARRAY(SEGNAM,ELMPOS,"VAL",I)=$GET(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,"DAT",ELMIEN,"VAL",I,0))
End DoDot:5
+38 ; - Customized ASAP Data Element Flagging
+39 IF ASAPDEF="CUSTOM ASAP DEFINITION"
Begin DoDot:5
+40 SET ASARRAY(SEGNAM,ELMPOS,"CUS")=1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 QUIT
+42 ;
SEGTREE(VERSION,DEFTYPE,ARRAY) ; Retrieve Hierarchical (Tree) Segement Positioning Information for each ASAP Version
+1 ; Input: (r) VERSION - ASAP Version (e.g., "3.0", "4.2", etc.)
+2 ; (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, B: Both)
+3 ;Output: ARRAY - Array containing Segment Hierarchically formatted (tree)
+4 ; Example: ARRAY(1)="TH"
+5 ; ARRAY(1,1)="IS"
+6 ; ARRAY(1,1,1)="PHA"
+7 ; ARRAY(1,1,1,1)="PAT"
+8 ; ARRAY(1,1,1,1,2)="DSP"
+9 ; ...
+10 ; ARRAY(1,1,2)="TP"
+11 ; ARRAY(2)="TT"
+12 NEW ASAPDEF,FILEIEN,VER,VERIEN,SEGIEN,SEG0,PARSEG,SEGPOS,SEGINFO
+13 ; Retrieving information about each Segment
+14 KILL @ARRAY
+15 FOR ASAPDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION"
Begin DoDot:1
+16 IF ASAPDEF="STANDARD ASAP DEFINITION"
IF DEFTYPE="C"
QUIT
+17 IF ASAPDEF="CUSTOM ASAP DEFINITION"
IF DEFTYPE="S"
QUIT
+18 SET FILEIEN=$ORDER(^PS(58.4,"B",ASAPDEF,0))
+19 FOR VER="ALL",VERSION
Begin DoDot:2
+20 ; - Prevent loading default (ALL) definitions for entirely cloned ASAP versions
+21 IF ASAPDEF="STANDARD ASAP DEFINITION"
IF '$DATA(^PS(58.4,FILEIEN,"VER","B",VERSION))
QUIT
+22 SET VERIEN=$ORDER(^PS(58.4,FILEIEN,"VER","B",VER,0))
IF 'VERIEN
QUIT
+23 SET SEGIEN=0
+24 FOR
SET SEGIEN=$ORDER(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN))
if 'SEGIEN
QUIT
Begin DoDot:3
+25 SET SEG0=$GET(^PS(58.4,FILEIEN,"VER",VERIEN,"SEG",SEGIEN,0))
+26 SET PARSEG=$PIECE(SEG0,"^",3)
+27 SET SEGPOS=+$PIECE(SEG0,"^",5)
+28 SET SEGINFO($PIECE(SEG0,"^"))=PARSEG_"^"_SEGPOS
+29 SET @ARRAY@($PIECE(SEG0,"^"))=SEG0
End DoDot:3
End DoDot:2
End DoDot:1
+30 ; Building the Segment Tree
+31 DO BLDTREE("",.SEGINFO,ARRAY)
+32 QUIT
+33 ;
BLDTREE(SEG,SEGINFO,ARRAY) ; Build the ASAP Segment Tree (Recursivity Used)
+1 ; Input: SEG - Initial Segment (Usually "" to build from the top of the tree)
+2 ; SEGINFO - Segment Information Array (Parent & Position)
+3 ;Output: ARRAY - ASAP Segment Tree (See above for format)
+4 NEW SEGNAM
+5 SET SEGNAM=""
+6 FOR
SET SEGNAM=$ORDER(SEGINFO(SEGNAM))
if SEGNAM=""
QUIT
Begin DoDot:1
+7 IF $PIECE(SEGINFO(SEGNAM),"^")'=SEG
QUIT
+8 SET @ARRAY@($PIECE(SEGINFO(SEGNAM),"^",2))=SEGNAM
+9 DO BLDTREE(SEGNAM,.SEGINFO,$QUERY(@ARRAY))
End DoDot:1
+10 QUIT
+11 ;
VERLIST(DEFTYPE,REGZERO,ARRAY) ; Return a list of ASAP Versions ;Zero Report adding REGZERO
+1 ; Input: (r) DEFTYPE - ASAP Definition Type (D: Default Only; C: Customized Only, F: Fully Customized Only,
+2 ; A: All. A combination is also allowed, e.g., "CF")
+3 ; (r) REGZERO - Regular or Zero Report or Both ASAP Definitions (R: Regular Only;
+4 ; Z: Zero Report Only; B: Both)
+5 ;Output: ARRAY - ASAP Version List (ARRAY("3.0")="S", ARRAY("4.0")="S", etc...)
+6 ; Standard CLONE PSO*7*772
NEW STDIEN,CUSIEN,VERSION,CLONE
+7 ;adding Zero Report flag
NEW VER,ZFLG
+8 ; Standard CLONE PSO*7*772
KILL ARRAY
SET CLONE=""
+9 SET STDIEN=$ORDER(^PS(58.4,"B","STANDARD ASAP DEFINITION",0))
+10 SET CUSIEN=$ORDER(^PS(58.4,"B","CUSTOM ASAP DEFINITION",0))
+11 IF DEFTYPE["A"!(DEFTYPE["S")
Begin DoDot:1
+12 SET VERSION=""
FOR
SET VERSION=$ORDER(^PS(58.4,STDIEN,"VER","B",VERSION))
if VERSION=""
QUIT
Begin DoDot:2
+13 IF VERSION="ALL"
QUIT
+14 SET VER=$ORDER(^PS(58.4,STDIEN,"VER","B",VERSION,0))
SET ZFLG=$PIECE($GET(^PS(58.4,STDIEN,"VER",VER,0)),"^",5)
+15 ;Zero ASAP only
IF REGZERO["Z"
IF 'ZFLG
QUIT
+16 ; PSO*7*772
SET CLONE=$$CLONE^PSOSPML3(VERSION)
+17 ;ASAP only
IF REGZERO["R"
IF ZFLG
QUIT
+18 ;both ASAP and Zero ASAP
IF REGZERO["B"
IF ZFLG
SET ARRAY(VERSION_" ")="SZ"
SET ARRAY(VERSION_" ","CLONE")=+$GET(CLONE)
QUIT
+19 SET ARRAY(VERSION_" ")="S"
+20 ; PSO*7*772
SET ARRAY(VERSION_" ","CLONE")=+$GET(CLONE)
End DoDot:2
End DoDot:1
+21 IF DEFTYPE["A"!(DEFTYPE["C")!(DEFTYPE["F")
Begin DoDot:1
+22 SET VERSION=""
FOR
SET VERSION=$ORDER(^PS(58.4,CUSIEN,"VER","B",VERSION))
if VERSION=""
QUIT
Begin DoDot:2
+23 ;if customized Zero Report
IF $DATA(ARRAY(VERSION_" "))
QUIT
+24 SET VER=$ORDER(^PS(58.4,CUSIEN,"VER","B",VERSION,0))
SET ZFLG=$PIECE($GET(^PS(58.4,CUSIEN,"VER",VER,0)),"^",5)
+25 ;Zero ASAP only
IF REGZERO["Z"
IF 'ZFLG
QUIT
+26 ;ASAP only
IF REGZERO["R"
IF ZFLG
QUIT
+27 IF DEFTYPE["A"!(DEFTYPE["C")
IF $DATA(^PS(58.4,STDIEN,"VER","B",VERSION))
SET ARRAY(VERSION_" ")="C"
+28 ;Zero Rpt
IF DEFTYPE["A"!(DEFTYPE["C")
IF $DATA(^PS(58.4,STDIEN,"VER","B",VERSION))
IF ZFLG
SET ARRAY(VERSION_" ")="CZ"
+29 IF DEFTYPE["A"!(DEFTYPE["F")
IF '$DATA(^PS(58.4,STDIEN,"VER","B",VERSION))
SET ARRAY(VERSION_" ")="F"
+30 ;Zero Rpt
IF DEFTYPE["A"!(DEFTYPE["F")
IF '$DATA(^PS(58.4,STDIEN,"VER","B",VERSION))
IF ZFLG
SET ARRAY(VERSION_" ")="FZ"
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
VERDATA(VERSION,DEFTYPE) ; Returns the ASAP Version fields
+1 ; Input: (r) VERSION - ASAP Version (e.g., "3.0", "4.2", etc.)
+2 ; (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, B: Both)
+3 ;Output: VERDATA - Sub-file #58.4001 0 node: "Version^Data Element Delimiter Char^Segment Terminator Char^..."
+4 NEW VERDATA,ASAPDEF,ASDEFIEN,VERIEN
+5 SET VERDATA=""
+6 FOR ASAPDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION"
Begin DoDot:1
+7 IF ASAPDEF="STANDARD ASAP DEFINITION"
IF DEFTYPE="C"
QUIT
+8 IF ASAPDEF="CUSTOM ASAP DEFINITION"
IF DEFTYPE="S"
QUIT
+9 SET ASDEFIEN=$ORDER(^PS(58.4,"B",ASAPDEF,0))
IF 'ASDEFIEN
QUIT
+10 SET VERIEN=$ORDER(^PS(58.4,ASDEFIEN,"VER","B",VERSION,0))
IF 'VERIEN
QUIT
+11 SET VERDATA=$GET(^PS(58.4,ASDEFIEN,"VER",VERIEN,0))
End DoDot:1
+12 QUIT VERDATA
+13 ;
VERZERO(PSOASVER) ; 772 - Is Version PSOASVER a Zero Report?
+1 NEW VERIEN,ZERO
+2 if '$GET(PSOASVER)
QUIT 0
+3 SET VERIEN=$ORDER(^PS(58.4,1,"VER","B",PSOASVER,0))
if 'VERIEN
QUIT 0
+4 SET ZERO=$PIECE($GET(^PS(58.4,1,"VER",VERIEN,0)),"^",5)
if ZERO
QUIT 1
+5 QUIT 0
+6 ;
+7 ;
VERSIONLOCKED(VERSEL) ; PSO*7*772
+1 ; check to see if VERSION is locked
+2 ; input - VERSEL = VERSION the end-user selected when
+3 ; executing the View/Edit ASAP Definitions option (e.g., 5.0)
+4 NEW PSOASDEF,PSOASIEN,PSOVER,PSOVERIEN,RETURN
+5 SET (PSOVER,RETURN)=0
+6 FOR PSOASDEF="STANDARD ASAP DEFINITION","CUSTOM ASAP DEFINITION"
Begin DoDot:1
+7 ; already found the version
if RETURN
QUIT
+8 SET PSOASIEN=$ORDER(^PS(58.4,"B",PSOASDEF,0))
+9 FOR
SET PSOVER=$ORDER(^PS(58.4,PSOASIEN,"VER","B",PSOVER))
if PSOVER=""
QUIT
Begin DoDot:2
+10 IF VERSEL=PSOVER
SET PSOVERIEN=$ORDER(^PS(58.4,PSOASIEN,"VER","B",PSOVER,0))
Begin DoDot:3
+11 IF +$$GET1^DIQ(58.4001,PSOVERIEN_","_PSOASIEN,.07,"I")
SET RETURN=1
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT RETURN
+13 ;
RESETELM(CUSIEN,VERIEN,SEGIEN,SEGID,ELMIEN,ELMID,ELMPOS,CUSASAP,STDASAP) ; Reset (Remove Customizations from) Data Element
+1 ; CUSIEN- IEN of the CUSTOM record name from the SPMP ASAP RECORD DEFINITIONS file (#58.4)
+2 ; VERIEN - IEN of the ASAP version from the VERSION sub-file (#58.4001) of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
+3 ; SEGIEN - IEN of the segment from the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
+4 ; SEGID - NAME (#.01) field value of the segment in the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
+5 ; ELMIEN - IEN of the element from the DATA ELEMENT sub-file (#58.400111) of the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
+6 ; ELMID - NAME (#.01) field value of the element in the DATA ELEMENT sub-file (#58.400111) of the SEGMENT sub-file (#58.40011) of the VERSION sub-file of the SPMP ASAP RECORD DEFINITIONS file (#58.4)
+7 ; ELMPOS - Position of the Data Element within the segment
+8 ; CUSASAP - Array of customizations from the CUSTOM ASAP DEFINITION node of the SPMP ASAP RECORD DEFINITIONS file (#58.4).
+9 ; STDASAP - Array of non-customized ASAP definition from the STANDARD ASAP DEFINITION node of the SPMP ASAP RECORD DEFINITIONS file (#58.4).
+10 ;
+11 NEW DIK,DA
+12 SET DIK="^PS(58.4,"_CUSIEN_",""VER"","_VERIEN_",""SEG"","_SEGIEN_",""DAT"","
+13 SET DA(3)=CUSIEN
SET DA(2)=VERIEN
SET DA(1)=SEGIEN
SET DA=ELMIEN
DO ^DIK
IF $GET(ELMPOS)
IF $PIECE($GET(CUSASAP(SEGID,ELMPOS)),"^")=ELMID
KILL CUSASAP(SEGID,ELMPOS)
+14 ; No customized elements in this segment, no customizations in this segment, remove custom segment
IF '$ORDER(CUSASAP(SEGID,""))
IF ($GET(CUSASAP(SEGID))=$GET(STDASAP(SEGID)))
Begin DoDot:1
+15 SET DIK="^PS(58.4,"_CUSIEN_",""VER"","_VERIEN_",""SEG"","
+16 SET DA(2)=CUSIEN
SET DA(1)=VERIEN
SET DA=SEGIEN
DO ^DIK
+17 KILL CUSASAP(SEGID)
End DoDot:1
+18 QUIT
+19 ;
ELMDIFF(SEGID,ELMPOS,ELMDATA,EDEMAXL,EDEREQ,MEXPR,ASAPAR) ; Compare NEW and OLD arrays
+1 NEW EDENAME,EDEFMT,EDESLINE,EDESDIFF,ASAPLINE
+2 IF '$LENGTH($GET(SEGID))
QUIT 1
+3 IF '$LENGTH($GET(ELMPOS))
QUIT 1
+4 IF '$LENGTH($GET(ELMDATA))
QUIT 1
+5 SET EDENAME=$PIECE(ELMDATA,"^",2)
SET EDEFMT=$PIECE(ELMDATA,"^",3)
+6 ; Element name was changed
IF $GET(EDENAME)'=$PIECE(ASAPAR(SEGID,ELMPOS),"^",2)
QUIT 1
+7 ; Data format was changed
IF $GET(EDEFMT)'=$PIECE(ASAPAR(SEGID,ELMPOS),"^",3)
QUIT 1
+8 ; Max length was changed
IF $GET(EDEMAXL)'=$PIECE(ASAPAR(SEGID,ELMPOS),"^",4)
QUIT 1
+9 ; Requirement was changed
IF $GET(EDEREQ)'=$PIECE(ASAPAR(SEGID,ELMPOS),"^",6)
QUIT 1
+10 ; (Return) Value was changed
IF $GET(MEXPR)'=$GET(ASAPAR(SEGID,ELMPOS,"VAL",1))
QUIT 1
+11 ;
+12 ; Number of lines of edited Description text
+13 SET EDESLINE=""
SET EDESLINE=$ORDER(ELMDATA("DES",EDESLINE),-1)
+14 ;
+15 ; Number of lines of comparison array Description text
+16 SET ASAPLINE=""
SET ASAPLINE=$ORDER(ASAPAR(SEGID,ELMPOS,"DES",ASAPLINE),-1)
+17 ;
+18 ; Number of lines of Description text has changed, that's a change
+19 IF ASAPLINE'=EDESLINE
QUIT 1
+20 ;
+21 ; If same number of lines in Description, check for changes
+22 SET EDESLINE=0
FOR
SET EDESLINE=$ORDER(ELMDATA("DES",EDESLINE))
if 'EDESLINE!$GET(EDESDIFF)
QUIT
Begin DoDot:1
+23 IF ELMDATA("DES",EDESLINE)'=$GET(ASAPAR(SEGID,ELMPOS,"DES",+$GET(EDESLINE)))
SET EDESDIFF=1
End DoDot:1
+24 ; Description has changed
if $GET(EDESDIFF)
QUIT 1
+25 ; Nothing has changed
QUIT 0
+26 ;
ASKMEXPR(LEVEL,ELMID,MAXLEN,DEFAULT) ; Prompt for M SET Expression
+1 ;Input: (r) LEVEL - Level of the Segment where the Data Element is located
+2 ; (r) ELMID - Data Element ID ("PHA01", "DSP02", etc.)
+3 ; (r) MAXLEN - Element ID value Maximum Length
+4 ; (o) DEFAULT - Default value
+5 ;Output: M SET Expression or "^"
+6 NEW ASKMEXPR,DONE,ERROR
+7 SET DONE=0
SET X=$GET(DEFAULT)
+8 FOR
Begin DoDot:1
+9 SET X=$GET(DEFAULT)
WRITE !,"M SET EXPRESSION: "_$SELECT(X'="":X_"// ",1:"")
+10 READ X:DTIME
if X=""
SET X=$GET(DEFAULT)
IF '$TEST!(X="^")
SET ASKMEXPR="^"
SET DONE=1
QUIT
+11 IF X["?"
WRITE !
DO MEXPRHLP^PSOSPML3(LEVEL,ELMID)
WRITE !
QUIT
+12 IF '$$VALID^PSOSPMU3(PSOASVER,X)
WRITE !,$PIECE($$VALID^PSOSPMU3(PSOASVER,X),"^",2),$CHAR(7),!
QUIT
+13 IF '$$CHKVAR^PSOSPMU3(LEVEL,X)
QUIT
+14 DO CHKCODE^PSOSPMU3(LEVEL,X,.ERROR)
IF ERROR
QUIT
+15 IF $EXTRACT(X,1)=""""
IF $EXTRACT(X,$LENGTH(X))=""""
IF $EXTRACT(X,2,$LENGTH(X)-1)'[""""
IF $LENGTH(X)-2>MAXLEN
Begin DoDot:2
+16 WRITE !,"The length cannot be longer than the maximum (",MAXLEN,").",$CHAR(7),!
End DoDot:2
QUIT
+17 SET ASKMEXPR=X
SET DONE=1
End DoDot:1
IF DONE
QUIT
+18 QUIT ASKMEXPR
