| 1 | VAQPST04 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | ALL ; --Creates an entry in the Segment Group file 394.84 of all segments
|
|---|
| 4 | I '$D(^VAT(394.71)) QUIT
|
|---|
| 5 | ;IF IT'S ALREADY THERE, DELETE IT
|
|---|
| 6 | S DA=""
|
|---|
| 7 | F S DA=+$O(^VAT(394.84,"B","ALL",DA)) Q:('DA) D
|
|---|
| 8 | .Q:($P(^VAT(394.84,DA,0),"^",2)=0)
|
|---|
| 9 | .S DIK="^VAT(394.84,"
|
|---|
| 10 | .D ^DIK K DIK
|
|---|
| 11 | W !," Creating a segment group called ""ALL"" "
|
|---|
| 12 | W !," This group will contain all data segments"
|
|---|
| 13 | S DIC="^VAT(394.84,",DIC(0)="L",DLAYGO=394.84,X="ALL"
|
|---|
| 14 | S DIC("DR")=".02///PUBLIC" ; -- Public
|
|---|
| 15 | K DD,DO
|
|---|
| 16 | D FILE^DICN K DIC,DLAYGO,X,DINUM
|
|---|
| 17 | I Y=-1 QUIT
|
|---|
| 18 | ; -- Add segments
|
|---|
| 19 | S DA=$P(Y,U,1),DIE="^VAT(394.84,",SEG=""
|
|---|
| 20 | F S SEG=$O(^VAT(394.71,"B",SEG)) Q:SEG="" D S1
|
|---|
| 21 | W !,"Done"
|
|---|
| 22 | K SEG,DA,DIE
|
|---|
| 23 | QUIT
|
|---|
| 24 | S1 ; -- Update existing entry
|
|---|
| 25 | W !," ",SEG," - added"
|
|---|
| 26 | S DR="10///"_SEG
|
|---|
| 27 | S DR(2,394.841)=".01///"_SEG
|
|---|
| 28 | D ^DIE K DR
|
|---|
| 29 | QUIT
|
|---|
| 30 | ;
|
|---|
| 31 | ;
|
|---|
| 32 | COP ; -- Creates entries in Segment group file from Health Summary Type file^GMT(142,
|
|---|
| 33 | N TMP
|
|---|
| 34 | I '$D(^GMT(142)) QUIT
|
|---|
| 35 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 36 | S DIR("A")="Create entries in Segment Groups from Health Summary Type File"
|
|---|
| 37 | D ^DIR K DIR
|
|---|
| 38 | I ('Y)!($D(DUOUT))!($D(DTOUT)) QUIT
|
|---|
| 39 | ;
|
|---|
| 40 | S GRP=""
|
|---|
| 41 | F S GRP=$O(^GMT(142,"B",GRP)) Q:GRP="" D G1
|
|---|
| 42 | QUIT
|
|---|
| 43 | ;
|
|---|
| 44 | G1 ;
|
|---|
| 45 | ;IF IT'S ALREADY THERE, DELETE IT
|
|---|
| 46 | S DA=""
|
|---|
| 47 | F S DA=+$O(^VAT(394.84,"B",GRP,DA)) Q:('DA) D
|
|---|
| 48 | .Q:($P(^VAT(394.84,DA,0),"^",2)=0)
|
|---|
| 49 | .S DIK="^VAT(394.84,"
|
|---|
| 50 | .D ^DIK K DIK
|
|---|
| 51 | Q:(GRP="GMTS HS ADHOC OPTION")
|
|---|
| 52 | S ENTRY="",ENTRY=$O(^GMT(142,"B",GRP,ENTRY))
|
|---|
| 53 | S DIC="^VAT(394.84,",DIC(0)="L",DLAYGO=394.84,X=GRP
|
|---|
| 54 | S DIC("DR")=".02///PUBLIC" ; -- Public
|
|---|
| 55 | K DD,DO
|
|---|
| 56 | D FILE^DICN K DIC,DLAYGO,X,DINUM
|
|---|
| 57 | I Y=-1 QUIT
|
|---|
| 58 | ; -- Set components within entry
|
|---|
| 59 | W !!,?3,GRP," <-- Segment group added, the list of components follows"
|
|---|
| 60 | S DA=$P(Y,U,1),DIE="^VAT(394.84,",SEGPT=""
|
|---|
| 61 | F S SEGPT=$O(^GMT(142,ENTRY,1,"C",SEGPT)) Q:SEGPT="" D S0
|
|---|
| 62 | K SEG,DA,DIE
|
|---|
| 63 | QUIT
|
|---|
| 64 | ;
|
|---|
| 65 | S0 ;
|
|---|
| 66 | S SEG=$P($G(^GMT(142.1,SEGPT,0)),U,4)
|
|---|
| 67 | S SEGNM=$P($G(^GMT(142.1,SEGPT,0)),U,1)
|
|---|
| 68 | ;FILTER OUT NON-SUPPORTED COMPONENTS
|
|---|
| 69 | I ((SEG'="")&($D(^VAT(394.71,"C",SEG)))) D S2
|
|---|
| 70 | QUIT
|
|---|
| 71 | ;
|
|---|
| 72 | S2 ; -- Update existing entry
|
|---|
| 73 | W !,?10,SEG
|
|---|
| 74 | S DR="10///"_SEG
|
|---|
| 75 | S DR(2,394.841)=".01///"_SEG
|
|---|
| 76 | ;DETERMINE IF TIME & OCCURRENCE LIMITS ARE APPLICABLE
|
|---|
| 77 | S TMP=$$LIMITS^VAQDBIH3(SEGPT)
|
|---|
| 78 | ;PUT TIME LIMIT OF 1 YEAR (IF APPLICABLE)
|
|---|
| 79 | S:($P(TMP,"^",1)) DR(2,394.841)=DR(2,394.841)_";.04///1Y"
|
|---|
| 80 | ;PUT OCCURRENCE LIMIT OF 10 (IF APPLICABLE)
|
|---|
| 81 | S:($P(TMP,"^",2)) DR(2,394.841)=DR(2,394.841)_";.05///10"
|
|---|
| 82 | D ^DIE K DR
|
|---|
| 83 | W ?16," - ",SEGNM
|
|---|
| 84 | QUIT
|
|---|
| 85 | ;
|
|---|
| 86 | END ; -- End of code
|
|---|
| 87 | QUIT
|
|---|
