PSOSPMU0 ;BIRM/MFR - State Prescription Monitoring Program - Load ASAP Definition Utility ;10/07/12
;;7.0;OUTPATIENT PHARMACY;**451,625,772**;DEC 1997;Build 105
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMU0 8731 printed Aug 26, 2025@22:51:17 Page 2
PSOSPMU0 ;BIRM/MFR - State Prescription Monitoring Program - Load ASAP Definition Utility ;10/07/12
+1 ;;7.0;OUTPATIENT PHARMACY;**451,625,772**;DEC 1997;Build 105
+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 ;