Routine: SR00109

SR00109 ;BIR/JLC - CONVERT DEFAULT BLOOD COMPONENTS;30 JUL 02

 ;;3.0; Surgery ;**109**;24 Jun 93

 ; Reference to ^LAB(66 supported by DBIA 210.

 ; Reference to ^DD(133 supported by DBIA 3646.

ENNV ;

 I $G(DUZ)="" W !,"Your DUZ is not defined.  It must be defined to run this routine." Q

 K ZTSAVE,ZTSK S ZTRTN="ENQN^SR00109",ZTDESC="CONVERT BLOOD COMPONENT INFORMATION (SURGERY)",ZTIO="" D ^%ZTLOAD

 W !!,"The conversion of blood component information in Surgery is",$S($D(ZTSK):"",1:" NOT")," queued",!

 I $D(ZTSK) D

 . W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."

ENQN ;

 ;Delete field from DD first

 S DIK="^DD(133,",DA=8,DA(1)=133 D ^DIK

 N CASE,DAYS,HOURS,MINS,NEW,OCNT,P,REQ,S0,SR,SRA,SRCREAT,SREXPR,SRF,SRP,STSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,NAME,BP

 D NOW^%DTC S SRSTART=$E(%,1,12),SRCREAT=$E(%,1,7),SREXPR=$$FMADD^XLFDT(SRCREAT,30,0,0,0)

 K ^XTMP("SR")

 S (SRA,OCNT)=0

 F  S SRA=$O(^SRO(133,SRA)) Q:'SRA  S SRP=$P($G(^SRO(133,SRA,0)),"^",9) I SRP]"",SRP?1.N D

 . S SRF=$P($G(^LAB(66,SRP,0)),"^")

 . I SRF]"" S ^SRO(133,SRA,7)=SRF,$P(^SRO(133,SRA,0),"^",9)="" Q

 . S ^XTMP("SR",1,SRA)=SRP,OCNT=OCNT+1,BP(1,SRF)=$G(BP(SRP))+1

 S CASE=0

 F  S CASE=$O(^SRF(CASE)) Q:'CASE  D

 . S A=$G(^SRF(CASE,11,0)) Q:A=""  S S0=0

 . F  S S0=$O(^SRF(CASE,11,S0)) Q:'S0  D

 .. S REQ=$P($G(^SRF(CASE,11,S0,0)),"^") Q:REQ=""  Q:REQ'?1.N

 .. I '$D(^LAB(66,REQ,0)) D SET Q

 .. S NEW=$P(^LAB(66,REQ,0),"^") I NEW="" D SET Q

 .. S $P(^SRF(CASE,11,S0,0),"^")=NEW

 I $D(^XTMP("SR")) S ^XTMP("SR",0)=SREXPR_"^"_SRCREAT

 D SENDMSG

 S ZTREQ="@"

SET S A=$G(^SRF(CASE,0)),^XTMP("SR",2,CASE)=$P(A,"^")_"^"_$P(A,"^",9)_"^"_REQ,OCNT=OCNT+1,BP(2,REQ)=$G(BP(2,REQ))+1

SENDMSG ;Send mail message when check is complete.

 K SR,XMY S XMDUZ="SURGERY,CONVERSION",XMSUB="SURGERY POINTER CONVERSION COMPLETED",XMTEXT="SR(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")

 S SR(1,0)="  The conversion of blood component information in Surgery V.3.0",SR(2,0)="completed as of "_Y_"."

 S X=$$FMDIFF^XLFDT(%,SRSTART,3) S:$L(X," ")>1 DAYS=+$P(X," "),X=$P(X," ",2) S HOURS=+$P(X,":"),MINS=+$P(X,":",2)

 S SR(3,0)=" ",SR(4,0)="This process completed in "_$S($G(DAYS):DAYS_" day"_$E("s",DAYS'=1)_", ",1:"")_HOURS_" hour"_$E("s",HOURS'=1)_" and "_MINS_" minute"_$E("s",MINS'=1)_"."

 S SR(5,0)=OCNT_" entries were found that could not be converted."

 I OCNT>0 D

 . S SR(6,0)=" ",SR(7,0)="These entries could not be converted because the associated"

 . S SR(8,0)="entry in the BLOOD PRODUCT file no longer exists."

 . S SR(9,0)=" ",SR(10,0)="The list of site parameters that could not be converted"

 . S SR(11,0)="      is contained in ^XTMP(""SR"",1",SR(12,0)=" "

 . S SRP=12,P="" F  S P=$O(BP(1,P)) Q:P=""  D

 .. S SRP=SRP+1,SR(SRP,0)="      "_BP(1,P)_$S(BP(1,P)=1:" entry",1:" entries")_" pointed to blood product "_P

 . S SRP=SRP+1,SR(SRP,0)=" ",SRP=SRP+1,SR(SRP,0)="The list of cases that could not be converted"

 . S SRP=SRP+1,SR(SRP,0)="      is contained in ^XTMP(""SR"",2",SRP=SRP+1,SR(SRP,0)=" "

 . S P="" F  S P=$O(BP(2,P)) Q:P=""  D

 .. S SRP=SRP+1,SR(SRP,0)="      "_BP(2,P)_$S(BP(2,P)=1:" entry",1:" entries")_" pointed to blood product "_P

 . S SRP=SRP+1,SR(SRP,0)=" ",SRP=SRP+1,SR(SRP,0)="In coordination with your Lab and Surgery ADPACs, determine"

 . S SRP=SRP+1,SR(SRP,0)="if you have the information required to rebuild these blood"

 . S SRP=SRP+1,SR(SRP,0)="products. If so, you may rebuild them and re-run the conversion."

 . S SRP=SRP+1,SR(SRP,0)="To re-run the conversion, type:"

 . S SRP=SRP+1,SR(SRP,0)=" D ENNV^SR00109 at the programmer's prompt."

 D ^XMD

SR00109   ;BIR/JLC - CONVERT DEFAULT BLOOD COMPONENTS;30 JUL 02

 +1       ;;3.0; Surgery ;**109**;24 Jun 93

 +2       ;

 +3       ; Reference to ^LAB(66 supported by DBIA 210.

 +4       ; Reference to ^DD(133 supported by DBIA 3646.

 +5       ;

ENNV      ;

 +1        IF $GET(DUZ)=""

               WRITE !,"Your DUZ is not defined.  It must be defined to run this routine."

               QUIT

 +2        KILL ZTSAVE,ZTSK

           SET ZTRTN="ENQN^SR00109"

           SET ZTDESC="CONVERT BLOOD COMPONENT INFORMATION (SURGERY)"

           SET ZTIO=""

           DO ^%ZTLOAD

 +3        WRITE !!,"The conversion of blood component information in Surgery is",$SELECT($DATA(ZTSK):"",1:" NOT")," queued",!

 +4        IF $DATA(ZTSK)

               Begin DoDot:1

 +5                WRITE " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."

               End DoDot:1

 +6        QUIT

ENQN      ;

 +1       ;Delete field from DD first

 +2        SET DIK="^DD(133,"

           SET DA=8

           SET DA(1)=133

           DO ^DIK

 +3        NEW CASE,DAYS,HOURS,MINS,NEW,OCNT,P,REQ,S0,SR,SRA,SRCREAT,SREXPR,SRF,SRP,STSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,NAME,BP

 +4        DO NOW^%DTC

           SET SRSTART=$EXTRACT(%,1,12)

           SET SRCREAT=$EXTRACT(%,1,7)

           SET SREXPR=$$FMADD^XLFDT(SRCREAT,30,0,0,0)

 +5        KILL ^XTMP("SR")

 +6        SET (SRA,OCNT)=0

 +7        FOR

               SET SRA=$ORDER(^SRO(133,SRA))

               IF 'SRA

                   QUIT

               SET SRP=$PIECE($GET(^SRO(133,SRA,0)),"^",9)

               IF SRP]""

                   IF SRP?1.N

                       Begin DoDot:1

 +8                        SET SRF=$PIECE($GET(^LAB(66,SRP,0)),"^")

 +9                        IF SRF]""

                               SET ^SRO(133,SRA,7)=SRF

                               SET $PIECE(^SRO(133,SRA,0),"^",9)=""

                               QUIT

 +10                       SET ^XTMP("SR",1,SRA)=SRP

                           SET OCNT=OCNT+1

                           SET BP(1,SRF)=$GET(BP(SRP))+1

                       End DoDot:1

 +11       SET CASE=0

 +12       FOR

               SET CASE=$ORDER(^SRF(CASE))

               IF 'CASE

                   QUIT

               Begin DoDot:1

 +13               SET A=$GET(^SRF(CASE,11,0))

                   IF A=""

                       QUIT

                   SET S0=0

 +14               FOR

                       SET S0=$ORDER(^SRF(CASE,11,S0))

                       IF 'S0

                           QUIT

                       Begin DoDot:2

 +15                       SET REQ=$PIECE($GET(^SRF(CASE,11,S0,0)),"^")

                           IF REQ=""

                               QUIT

                           IF REQ'?1.N

                               QUIT

 +16                       IF '$DATA(^LAB(66,REQ,0))

                               DO SET

                               QUIT

 +17                       SET NEW=$PIECE(^LAB(66,REQ,0),"^")

                           IF NEW=""

                               DO SET

                               QUIT

 +18                       SET $PIECE(^SRF(CASE,11,S0,0),"^")=NEW

                       End DoDot:2

               End DoDot:1

 +19       IF $DATA(^XTMP("SR"))

               SET ^XTMP("SR",0)=SREXPR_"^"_SRCREAT

 +20       DO SENDMSG

 +21       SET ZTREQ="@"

 +22       QUIT

SET        SET A=$GET(^SRF(CASE,0))

           SET ^XTMP("SR",2,CASE)=$PIECE(A,"^")_"^"_$PIECE(A,"^",9)_"^"_REQ

           SET OCNT=OCNT+1

           SET BP(2,REQ)=$GET(BP(2,REQ))+1

 +1        QUIT

SENDMSG   ;Send mail message when check is complete.

 +1        KILL SR,XMY

           SET XMDUZ="SURGERY,CONVERSION"

           SET XMSUB="SURGERY POINTER CONVERSION COMPLETED"

           SET XMTEXT="SR("

           SET XMY(DUZ)=""

           DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

 +2        SET SR(1,0)="  The conversion of blood component information in Surgery V.3.0"

           SET SR(2,0)="completed as of "_Y_"."

 +3        SET X=$$FMDIFF^XLFDT(%,SRSTART,3)

           IF $LENGTH(X," ")>1

               SET DAYS=+$PIECE(X," ")

               SET X=$PIECE(X," ",2)

           SET HOURS=+$PIECE(X,":")

           SET MINS=+$PIECE(X,":",2)

 +4        SET SR(3,0)=" "

           SET SR(4,0)="This process completed in "_$SELECT($GET(DAYS):DAYS_" day"_$EXTRACT("s",DAYS'=1)_", ",1:"")_HOURS_" hour"_$EXTRACT("s",HOURS'=1)_" and "_MINS_" minute"_$EXTRACT("s",MINS'=1)_"."

 +5        SET SR(5,0)=OCNT_" entries were found that could not be converted."

 +6        IF OCNT>0

               Begin DoDot:1

 +7                SET SR(6,0)=" "

                   SET SR(7,0)="These entries could not be converted because the associated"

 +8                SET SR(8,0)="entry in the BLOOD PRODUCT file no longer exists."

 +9                SET SR(9,0)=" "

                   SET SR(10,0)="The list of site parameters that could not be converted"

 +10               SET SR(11,0)="      is contained in ^XTMP(""SR"",1"

                   SET SR(12,0)=" "

 +11               SET SRP=12

                   SET P=""

FOR

                       SET P=$ORDER(BP(1,P))

                       IF P=""

                           QUIT

                       Begin DoDot:2

 +12                       SET SRP=SRP+1

                           SET SR(SRP,0)="      "_BP(1,P)_$SELECT(BP(1,P)=1:" entry",1:" entries")_" pointed to blood product "_P

                       End DoDot:2

 +13               SET SRP=SRP+1

                   SET SR(SRP,0)=" "

                   SET SRP=SRP+1

                   SET SR(SRP,0)="The list of cases that could not be converted"

 +14               SET SRP=SRP+1

                   SET SR(SRP,0)="      is contained in ^XTMP(""SR"",2"

                   SET SRP=SRP+1

                   SET SR(SRP,0)=" "

 +15               SET P=""

FOR

                       SET P=$ORDER(BP(2,P))

                       IF P=""

                           QUIT

                       Begin DoDot:2

 +16                       SET SRP=SRP+1

                           SET SR(SRP,0)="      "_BP(2,P)_$SELECT(BP(2,P)=1:" entry",1:" entries")_" pointed to blood product "_P

                       End DoDot:2

 +17               SET SRP=SRP+1

                   SET SR(SRP,0)=" "

                   SET SRP=SRP+1

                   SET SR(SRP,0)="In coordination with your Lab and Surgery ADPACs, determine"

 +18               SET SRP=SRP+1

                   SET SR(SRP,0)="if you have the information required to rebuild these blood"

 +19               SET SRP=SRP+1

                   SET SR(SRP,0)="products. If so, you may rebuild them and re-run the conversion."

 +20               SET SRP=SRP+1

                   SET SR(SRP,0)="To re-run the conversion, type:"

 +21               SET SRP=SRP+1

                   SET SR(SRP,0)=" D ENNV^SR00109 at the programmer's prompt."

               End DoDot:1

 +22       DO ^XMD

 +23       QUIT

SR00109.m