VAQPST04.m

VAQPST04 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93

 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993

ALL ; --Creates an entry in the Segment Group file 394.84 of all segments

 I '$D(^VAT(394.71)) QUIT

 ;IF IT'S ALREADY THERE, DELETE IT

 S DA=""

 F  S DA=+$O(^VAT(394.84,"B","ALL",DA)) Q:('DA)  D

 .Q:($P(^VAT(394.84,DA,0),"^",2)=0)

 .S DIK="^VAT(394.84,"

 .D ^DIK K DIK

 W !,"  Creating a segment group called ""ALL"" "

 W !,"  This group will contain all data segments"

 S DIC="^VAT(394.84,",DIC(0)="L",DLAYGO=394.84,X="ALL"

 S DIC("DR")=".02///PUBLIC" ; -- Public

 K DD,DO

 D FILE^DICN K DIC,DLAYGO,X,DINUM

 I Y=-1 QUIT

 ; -- Add segments

 S DA=$P(Y,U,1),DIE="^VAT(394.84,",SEG=""

 F  S SEG=$O(^VAT(394.71,"B",SEG)) Q:SEG=""  D S1

 W !,"Done"

 K SEG,DA,DIE

 QUIT

S1 ; -- Update existing entry

 W !,"    ",SEG," - added"

 S DR="10///"_SEG

 S DR(2,394.841)=".01///"_SEG

 D ^DIE K DR

 QUIT

 ;

 ;

COP ; -- Creates entries in Segment group file from Health Summary Type file^GMT(142,

 N TMP

 I '$D(^GMT(142)) QUIT

 S DIR(0)="Y",DIR("B")="NO"

 S DIR("A")="Create entries in Segment Groups from Health Summary Type File"

 D ^DIR K DIR

 I ('Y)!($D(DUOUT))!($D(DTOUT)) QUIT

 ;

 S GRP=""

 F  S GRP=$O(^GMT(142,"B",GRP)) Q:GRP=""  D G1

 QUIT

 ;

G1 ;

 ;IF IT'S ALREADY THERE, DELETE IT

 S DA=""

 F  S DA=+$O(^VAT(394.84,"B",GRP,DA)) Q:('DA)  D

 .Q:($P(^VAT(394.84,DA,0),"^",2)=0)

 .S DIK="^VAT(394.84,"

 .D ^DIK K DIK

 Q:(GRP="GMTS HS ADHOC OPTION")

 S ENTRY="",ENTRY=$O(^GMT(142,"B",GRP,ENTRY))

 S DIC="^VAT(394.84,",DIC(0)="L",DLAYGO=394.84,X=GRP

 S DIC("DR")=".02///PUBLIC" ; -- Public

 K DD,DO

 D FILE^DICN K DIC,DLAYGO,X,DINUM

 I Y=-1 QUIT

 ; -- Set components within entry

 W !!,?3,GRP," <-- Segment group added, the list of components follows"

 S DA=$P(Y,U,1),DIE="^VAT(394.84,",SEGPT=""

 F  S SEGPT=$O(^GMT(142,ENTRY,1,"C",SEGPT)) Q:SEGPT=""  D S0

 K SEG,DA,DIE

 QUIT

 ;

S0 ;

 S SEG=$P($G(^GMT(142.1,SEGPT,0)),U,4)

 S SEGNM=$P($G(^GMT(142.1,SEGPT,0)),U,1)

 ;FILTER OUT NON-SUPPORTED COMPONENTS

 I ((SEG'="")&($D(^VAT(394.71,"C",SEG)))) D S2

 QUIT

 ;

S2 ; -- Update existing entry

 W !,?10,SEG

 S DR="10///"_SEG

 S DR(2,394.841)=".01///"_SEG

 ;DETERMINE IF TIME & OCCURRENCE LIMITS ARE APPLICABLE

 S TMP=$$LIMITS^VAQDBIH3(SEGPT)

 ;PUT TIME LIMIT OF 1 YEAR (IF APPLICABLE)

 S:($P(TMP,"^",1)) DR(2,394.841)=DR(2,394.841)_";.04///1Y"

 ;PUT OCCURRENCE LIMIT OF 10 (IF APPLICABLE)

 S:($P(TMP,"^",2)) DR(2,394.841)=DR(2,394.841)_";.05///10"

 D ^DIE K DR

 W ?16," - ",SEGNM

 QUIT

 ;

END ; -- End of code

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VAQPST04   2581     printed  Mar 13, 2025@21:30:54                                                                                                                                                                                                    Page 2

VAQPST04  ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93

 +1       ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993

ALL       ; --Creates an entry in the Segment Group file 394.84 of all segments

 +1        IF '$DATA(^VAT(394.71))

               QUIT 

 +2       ;IF IT'S ALREADY THERE, DELETE IT

 +3        SET DA=""

 +4        FOR 

               SET DA=+$ORDER(^VAT(394.84,"B","ALL",DA))

               if ('DA)

                   QUIT 

               Begin DoDot:1

 +5                if ($PIECE(^VAT(394.84,DA,0),"^",2)=0)

                       QUIT 

 +6                SET DIK="^VAT(394.84,"

 +7                DO ^DIK

                   KILL DIK

               End DoDot:1

 +8        WRITE !,"  Creating a segment group called ""ALL"" "

 +9        WRITE !,"  This group will contain all data segments"

 +10       SET DIC="^VAT(394.84,"

           SET DIC(0)="L"

           SET DLAYGO=394.84

           SET X="ALL"

 +11      ; -- Public

           SET DIC("DR")=".02///PUBLIC"

 +12       KILL DD,DO

 +13       DO FILE^DICN

           KILL DIC,DLAYGO,X,DINUM

 +14       IF Y=-1

               QUIT 

 +15      ; -- Add segments

 +16       SET DA=$PIECE(Y,U,1)

           SET DIE="^VAT(394.84,"

           SET SEG=""

 +17       FOR 

               SET SEG=$ORDER(^VAT(394.71,"B",SEG))

               if SEG=""

                   QUIT 

               DO S1

 +18       WRITE !,"Done"

 +19       KILL SEG,DA,DIE

 +20       QUIT 

S1        ; -- Update existing entry

 +1        WRITE !,"    ",SEG," - added"

 +2        SET DR="10///"_SEG

 +3        SET DR(2,394.841)=".01///"_SEG

 +4        DO ^DIE

           KILL DR

 +5        QUIT 

 +6       ;

 +7       ;

COP       ; -- Creates entries in Segment group file from Health Summary Type file^GMT(142,

 +1        NEW TMP

 +2        IF '$DATA(^GMT(142))

               QUIT 

 +3        SET DIR(0)="Y"

           SET DIR("B")="NO"

 +4        SET DIR("A")="Create entries in Segment Groups from Health Summary Type File"

 +5        DO ^DIR

           KILL DIR

 +6        IF ('Y)!($DATA(DUOUT))!($DATA(DTOUT))

               QUIT 

 +7       ;

 +8        SET GRP=""

 +9        FOR 

               SET GRP=$ORDER(^GMT(142,"B",GRP))

               if GRP=""

                   QUIT 

               DO G1

 +10       QUIT 

 +11      ;

G1        ;

 +1       ;IF IT'S ALREADY THERE, DELETE IT

 +2        SET DA=""

 +3        FOR 

               SET DA=+$ORDER(^VAT(394.84,"B",GRP,DA))

               if ('DA)

                   QUIT 

               Begin DoDot:1

 +4                if ($PIECE(^VAT(394.84,DA,0),"^",2)=0)

                       QUIT 

 +5                SET DIK="^VAT(394.84,"

 +6                DO ^DIK

                   KILL DIK

               End DoDot:1

 +7        if (GRP="GMTS HS ADHOC OPTION")

               QUIT 

 +8        SET ENTRY=""

           SET ENTRY=$ORDER(^GMT(142,"B",GRP,ENTRY))

 +9        SET DIC="^VAT(394.84,"

           SET DIC(0)="L"

           SET DLAYGO=394.84

           SET X=GRP

 +10      ; -- Public

           SET DIC("DR")=".02///PUBLIC"

 +11       KILL DD,DO

 +12       DO FILE^DICN

           KILL DIC,DLAYGO,X,DINUM

 +13       IF Y=-1

               QUIT 

 +14      ; -- Set components within entry

 +15       WRITE !!,?3,GRP," <-- Segment group added, the list of components follows"

 +16       SET DA=$PIECE(Y,U,1)

           SET DIE="^VAT(394.84,"

           SET SEGPT=""

 +17       FOR 

               SET SEGPT=$ORDER(^GMT(142,ENTRY,1,"C",SEGPT))

               if SEGPT=""

                   QUIT 

               DO S0

 +18       KILL SEG,DA,DIE

 +19       QUIT 

 +20      ;

S0        ;

 +1        SET SEG=$PIECE($GET(^GMT(142.1,SEGPT,0)),U,4)

 +2        SET SEGNM=$PIECE($GET(^GMT(142.1,SEGPT,0)),U,1)

 +3       ;FILTER OUT NON-SUPPORTED COMPONENTS

 +4        IF ((SEG'="")&($DATA(^VAT(394.71,"C",SEG))))

               DO S2

 +5        QUIT 

 +6       ;

S2        ; -- Update existing entry

 +1        WRITE !,?10,SEG

 +2        SET DR="10///"_SEG

 +3        SET DR(2,394.841)=".01///"_SEG

 +4       ;DETERMINE IF TIME & OCCURRENCE LIMITS ARE APPLICABLE

 +5        SET TMP=$$LIMITS^VAQDBIH3(SEGPT)

 +6       ;PUT TIME LIMIT OF 1 YEAR (IF APPLICABLE)

 +7        if ($PIECE(TMP,"^",1))

               SET DR(2,394.841)=DR(2,394.841)_";.04///1Y"

 +8       ;PUT OCCURRENCE LIMIT OF 10 (IF APPLICABLE)

 +9        if ($PIECE(TMP,"^",2))

               SET DR(2,394.841)=DR(2,394.841)_";.05///10"

 +10       DO ^DIE

           KILL DR

 +11       WRITE ?16," - ",SEGNM

 +12       QUIT 

 +13      ;

END       ; -- End of code

 +1        QUIT