BTPW12PS.m

BTPW12PS ;GDHD/HCS/ALA-CMET V 1.2 Postinsall ; 03 Feb 2017  12:02 PM

 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71

 ;

EN ;EP - Postinstall

 ; Update pointers IN CMET

 NEW PRCN,TXN,TTYP,VAL,BTPWUPD

 S PRCN=0

 F  S PRCN=$O(^BTPW(90621,PRCN)) Q:'PRCN  D

 . S BTPWUPD(90621,PRCN_",",.13)="@",BTPWUPD(90621,PRCN_",",.14)="@"

 . S TXN=0

 . F  S TXN=$O(^BTPW(90621,PRCN,1,TXN)) Q:'TXN  D

 .. S TTYP=$P(^BTPW(90621,PRCN,1,TXN,0),U,3),TAX=$P(^(0),U,1)

 .. I TTYP=3 D

 ... I $P(^BTPW(90621,PRCN,1,TXN,0),"^",5)'="" D

 .... NEW IENS,DA

 .... S DA(1)=PRCN,DA=TXN,IENS=$$IENS^DILF(.DA)

 .... S BTPWUPD(90621.01,IENS,.05)="@",BTPWUPD(90621.01,IENS,.06)="@"

 .. S TTYP=$S(TTYP=3:"L",1:"N")

 .. S VAL=$$STXPT(TAX,TTYP)

 .. NEW DA,IENS

 .. S DA(1)=PRCN,DA=TXN,IENS=$$IENS^DILF(.DA)

 .. S BTPWUPD(90621.01,IENS,.02)=VAL

 D FILE^DIE("","BTPWUPD","ERROR")

 Q

 ;

STXPT(TXNM,TYP) ;  Set taxonomy pointer

 ;Input

 ;  TXNM - Taxonomy name

 ;  TYP  - Taxonomy Type (L = LAB, N = Non Lab)

 NEW IEN,SIEN,DA,IENS,BQUPD,VALUE,GLB

 S VALUE=""

 I TYP="L" D

 . S IEN=$O(^ATXLAB("B",TXNM,"")),GLB="ATXLAB("

 . I IEN="" S TYP="N"

 I TYP="N" S IEN=$O(^ATXAX("B",TXNM,"")),GLB="ATXAX("

 I IEN="" S VALUE="@"

 I IEN'="" S VALUE=IEN_";"_GLB

 Q VALUE

BTPW12PS  ;GDHD/HCS/ALA-CMET V 1.2 Postinsall ; 03 Feb 2017  12:02 PM

 +1       ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71

 +2       ;

EN        ;EP - Postinstall

 +1       ; Update pointers IN CMET

 +2        NEW PRCN,TXN,TTYP,VAL,BTPWUPD

 +3        SET PRCN=0

 +4        FOR 

               SET PRCN=$ORDER(^BTPW(90621,PRCN))

               IF 'PRCN

                   QUIT 

               Begin DoDot:1

 +5                SET BTPWUPD(90621,PRCN_",",.13)="@"

                   SET BTPWUPD(90621,PRCN_",",.14)="@"

 +6                SET TXN=0

 +7                FOR 

                       SET TXN=$ORDER(^BTPW(90621,PRCN,1,TXN))

                       IF 'TXN

                           QUIT 

                       Begin DoDot:2

 +8                        SET TTYP=$PIECE(^BTPW(90621,PRCN,1,TXN,0),U,3)

                           SET TAX=$PIECE(^(0),U,1)

 +9                        IF TTYP=3

                               Begin DoDot:3

 +10                               IF $PIECE(^BTPW(90621,PRCN,1,TXN,0),"^",5)'=""

                                       Begin DoDot:4

 +11                                       NEW IENS,DA

 +12                                       SET DA(1)=PRCN

                                           SET DA=TXN

                                           SET IENS=$$IENS^DILF(.DA)

 +13                                       SET BTPWUPD(90621.01,IENS,.05)="@"

                                           SET BTPWUPD(90621.01,IENS,.06)="@"

                                       End DoDot:4

                               End DoDot:3

 +14                       SET TTYP=$SELECT(TTYP=3:"L",1:"N")

 +15                       SET VAL=$$STXPT(TAX,TTYP)

 +16                       NEW DA,IENS

 +17                       SET DA(1)=PRCN

                           SET DA=TXN

                           SET IENS=$$IENS^DILF(.DA)

 +18                       SET BTPWUPD(90621.01,IENS,.02)=VAL

                       End DoDot:2

               End DoDot:1

 +19       DO FILE^DIE("","BTPWUPD","ERROR")

 +20       QUIT 

 +21      ;

STXPT(TXNM,TYP) ;  Set taxonomy pointer

 +1       ;Input

 +2       ;  TXNM - Taxonomy name

 +3       ;  TYP  - Taxonomy Type (L = LAB, N = Non Lab)

 +4        NEW IEN,SIEN,DA,IENS,BQUPD,VALUE,GLB

 +5        SET VALUE=""

 +6        IF TYP="L"

               Begin DoDot:1

 +7                SET IEN=$ORDER(^ATXLAB("B",TXNM,""))

                   SET GLB="ATXLAB("

 +8                IF IEN=""

                       SET TYP="N"

               End DoDot:1

 +9        IF TYP="N"

               SET IEN=$ORDER(^ATXAX("B",TXNM,""))

               SET GLB="ATXAX("

 +10       IF IEN=""

               SET VALUE="@"

 +11       IF IEN'=""

               SET VALUE=IEN_";"_GLB

 +12       QUIT VALUE