BQI24P2.m

BQI24P2 ;GDHS/HCS/ALA-Version 2.4 Patch 2 ; 02 Nov 2015  3:11 PM

 ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10

 ;

 ;

PRE ;

 Q

 ;

POS ; EP

 NEW DZ,FN,TF

 I $D(^BQICARE(.5)) K ^BQICARE(.5)

 S DZ=0

 F  S DZ=$O(^BQICARE(DZ)) Q:'DZ  D

 . S FN=0 Q:DZ'=1074

 . F  S FN=$O(^BQICARE(DZ,10,FN)) Q:'FN  D

 .. S TF=1

 .. I $P($G(^BQICARE(DZ,10,FN,1,TF,0)),"^",2)="T-6M" D

 ... NEW IENS,DA

 ... S DA(2)=DZ,DA(1)=FN,DA=TF,IENS=$$IENS^DILF(.DA)

 ... S BQIUPD(90505.1,IENS,.02)="T-2M"

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

 ;

 NEW DFN

 S DFN=0

 F  S DFN=$O(^BQIPAT(DFN)) Q:'DFN  I $P($G(^BQIPAT(DFN,0)),"^",1)="" S $P(^BQIPAT(DFN,0),"^",1)=DFN,^BQIPAT("B",DFN,DFN)=""

 Q

BQI24P2   ;GDHS/HCS/ALA-Version 2.4 Patch 2 ; 02 Nov 2015  3:11 PM

 +1       ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10

 +2       ;

 +3       ;

PRE       ;

 +1        QUIT 

 +2       ;

POS       ; EP

 +1        NEW DZ,FN,TF

 +2        IF $DATA(^BQICARE(.5))

               KILL ^BQICARE(.5)

 +3        SET DZ=0

 +4        FOR 

               SET DZ=$ORDER(^BQICARE(DZ))

               IF 'DZ

                   QUIT 

               Begin DoDot:1

 +5                SET FN=0

                   IF DZ'=1074

                       QUIT 

 +6                FOR 

                       SET FN=$ORDER(^BQICARE(DZ,10,FN))

                       IF 'FN

                           QUIT 

                       Begin DoDot:2

 +7                        SET TF=1

 +8                        IF $PIECE($GET(^BQICARE(DZ,10,FN,1,TF,0)),"^",2)="T-6M"

                               Begin DoDot:3

 +9                                NEW IENS,DA

 +10                               SET DA(2)=DZ

                                   SET DA(1)=FN

                                   SET DA=TF

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

 +11                               SET BQIUPD(90505.1,IENS,.02)="T-2M"

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       DO FILE^DIE("","BQIUPD","ERROR")

 +13      ;

 +14       NEW DFN

 +15       SET DFN=0

 +16       FOR 

               SET DFN=$ORDER(^BQIPAT(DFN))

               IF 'DFN

                   QUIT 

               IF $PIECE($GET(^BQIPAT(DFN,0)),"^",1)=""

                   SET $PIECE(^BQIPAT(DFN,0),"^",1)=DFN

                   SET ^BQIPAT("B",DFN,DFN)=""

 +17       QUIT