- BQIRGPD ;GDHD/HCS/ALA-Pediatrics ; 14 Dec 2016 2:13 PM
- ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- ;;
- ;
- LAB ;EP - Pull out pediatric lab tests
- NEW LRES,RES
- S LRES=$$ITM^BQICMUTL("",BQDFN,FREF,RREF,ITM,TAX,.TREF)
- I $P(LRES,U,1)=0 S RESULT=0 Q
- S RES=$P(LRES,U,7) I RES="" S RES=$P(LRES,U,6)
- S RESULT=1_U_$P(LRES,U,2)_U_RES
- Q
- ;
- LBT ;EP - Set up lab tests
- NEW TAX,TREF
- S TAX="BQI PEDIATRIC LAB TESTS"
- S TREF=$NA(^TMP("BQIRGPD",$J)) K @TREF
- D BLD^BQITUTL(TAX,.TREF,"L")
- ; Clean up labs
- NEW DA,IENS,CIEN,COD
- S CIEN=$O(^BQI(90506.5,"B","Pediatric","")) I CIEN="" Q
- S COD=$P(^BQI(90506.5,CIEN,0),"^",2)
- S DA=0,DA(1)=CIEN
- F S DA=$O(^BQI(90506.5,CIEN,10,DA)) Q:'DA D
- . S IENS=$$IENS^DILF(.DA)
- . S BQIUPD(90506.51,IENS,.09)=1
- I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
- ;
- ; Set up lab tests
- NEW BN,CT,CD,DA,IENS,DIC,DESC,PNL,DLAYGO,DIC,X,Y,NM,NAME
- S BN=0
- F S BN=$O(@TREF@(BN)) Q:'BN D
- . S NM=$P(^LAB(60,BN,.1),U,1),NAME=$P(^LAB(60,BN,0),"^",1)
- . S PNL=0 I $O(^LAB(60,BN,2,0))'="" S PNL=1
- . S IEN=$O(^BQI(90506.5,CIEN,10,"C",NM,""))
- . I IEN'="" D
- .. S DA(1)=CIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
- .. S BQIUPD(90506.51,IENS,.09)="@"
- .. D FILE^DIE("","BQIUPD","ERROR")
- .. I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
- .. I 'PNL S DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
- .. D WP^DIE(90506.51,IENS,4,"","DESC")
- . I IEN="" D
- .. S CT=$P($G(^BQI(90506.5,CIEN,10,0)),U,3),CT=CT+1
- .. S CD=COD_"_"_$E("0000",$L(CT),2)_CT
- .. S DA(1)=CIEN,X=CD,DIC="^BQI(90506.5,"_DA(1)_",10,",DIC(0)="L",DLAYGO=90506.51
- .. K DO,DD D FILE^DICN S DA=+Y
- .. S IENS=$$IENS^DILF(.DA)
- .. S BQIUPD(90506.51,IENS,.02)=3,BQIUPD(90506.51,IENS,.03)=NM
- .. S BQIUPD(90506.51,IENS,.04)=BN,BQIUPD(90506.51,IENS,.05)="B"
- .. S BQIUPD(90506.51,IENS,.06)="O",BQIUPD(90506.51,IENS,.08)="A"
- .. S BQIUPD(90506.51,IENS,1)="D LAB^BQIRGPD"
- .. D FILE^DIE("","BQIUPD","ERROR")
- .. I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
- .. I 'PNL S DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
- .. D WP^DIE(90506.51,IENS,4,"","DESC")
- K @TREF
- Q
- BQIRGPD ;GDHD/HCS/ALA-Pediatrics ; 14 Dec 2016 2:13 PM
- +1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- +2 ;;
- +3 ;
- LAB ;EP - Pull out pediatric lab tests
- +1 NEW LRES,RES
- +2 SET LRES=$$ITM^BQICMUTL("",BQDFN,FREF,RREF,ITM,TAX,.TREF)
- +3 IF $PIECE(LRES,U,1)=0
- SET RESULT=0
- QUIT
- +4 SET RES=$PIECE(LRES,U,7)
- IF RES=""
- SET RES=$PIECE(LRES,U,6)
- +5 SET RESULT=1_U_$PIECE(LRES,U,2)_U_RES
- +6 QUIT
- +7 ;
- LBT ;EP - Set up lab tests
- +1 NEW TAX,TREF
- +2 SET TAX="BQI PEDIATRIC LAB TESTS"
- +3 SET TREF=$NAME(^TMP("BQIRGPD",$JOB))
- KILL @TREF
- +4 DO BLD^BQITUTL(TAX,.TREF,"L")
- +5 ; Clean up labs
- +6 NEW DA,IENS,CIEN,COD
- +7 SET CIEN=$ORDER(^BQI(90506.5,"B","Pediatric",""))
- IF CIEN=""
- QUIT
- +8 SET COD=$PIECE(^BQI(90506.5,CIEN,0),"^",2)
- +9 SET DA=0
- SET DA(1)=CIEN
- +10 FOR
- SET DA=$ORDER(^BQI(90506.5,CIEN,10,DA))
- IF 'DA
- QUIT
- Begin DoDot:1
- +11 SET IENS=$$IENS^DILF(.DA)
- +12 SET BQIUPD(90506.51,IENS,.09)=1
- End DoDot:1
- +13 IF $DATA(BQIUPD)
- DO FILE^DIE("","BQIUPD","ERROR")
- +14 ;
- +15 ; Set up lab tests
- +16 NEW BN,CT,CD,DA,IENS,DIC,DESC,PNL,DLAYGO,DIC,X,Y,NM,NAME
- +17 SET BN=0
- +18 FOR
- SET BN=$ORDER(@TREF@(BN))
- IF 'BN
- QUIT
- Begin DoDot:1
- +19 SET NM=$PIECE(^LAB(60,BN,.1),U,1)
- SET NAME=$PIECE(^LAB(60,BN,0),"^",1)
- +20 SET PNL=0
- IF $ORDER(^LAB(60,BN,2,0))'=""
- SET PNL=1
- +21 SET IEN=$ORDER(^BQI(90506.5,CIEN,10,"C",NM,""))
- +22 IF IEN'=""
- Begin DoDot:2
- +23 SET DA(1)=CIEN
- SET DA=IEN
- SET IENS=$$IENS^DILF(.DA)
- +24 SET BQIUPD(90506.51,IENS,.09)="@"
- +25 DO FILE^DIE("","BQIUPD","ERROR")
- +26 IF PNL
- SET DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
- +27 IF 'PNL
- SET DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
- +28 DO WP^DIE(90506.51,IENS,4,"","DESC")
- End DoDot:2
- +29 IF IEN=""
- Begin DoDot:2
- +30 SET CT=$PIECE($GET(^BQI(90506.5,CIEN,10,0)),U,3)
- SET CT=CT+1
- +31 SET CD=COD_"_"_$EXTRACT("0000",$LENGTH(CT),2)_CT
- +32 SET DA(1)=CIEN
- SET X=CD
- SET DIC="^BQI(90506.5,"_DA(1)_",10,"
- SET DIC(0)="L"
- SET DLAYGO=90506.51
- +33 KILL DO,DD
- DO FILE^DICN
- SET DA=+Y
- +34 SET IENS=$$IENS^DILF(.DA)
- +35 SET BQIUPD(90506.51,IENS,.02)=3
- SET BQIUPD(90506.51,IENS,.03)=NM
- +36 SET BQIUPD(90506.51,IENS,.04)=BN
- SET BQIUPD(90506.51,IENS,.05)="B"
- +37 SET BQIUPD(90506.51,IENS,.06)="O"
- SET BQIUPD(90506.51,IENS,.08)="A"
- +38 SET BQIUPD(90506.51,IENS,1)="D LAB^BQIRGPD"
- +39 DO FILE^DIE("","BQIUPD","ERROR")
- +40 IF PNL
- SET DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
- +41 IF 'PNL
- SET DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
- +42 DO WP^DIE(90506.51,IENS,4,"","DESC")
- End DoDot:2
- End DoDot:1
- +43 KILL @TREF
- +44 QUIT
