VENPCC1K.m

VENPCC1K ; IHS/OIT/GIS - SPECIAL DISPLAY OF PROBLEMS AND POVS ; 

 ;;2.6;PCC+;;NOV 12, 2007

 ;

 ; SPECIAL PROBLEM DISPLAY FOR VER 2.5

 ; 

PROB(DFN,DEPTIEN) ; EP - SPECIAL PROBLEM DISPLAY

 N TMP

 S TMP="^TMP(""VEN PRNT"",$J)"

 D APL(DFN) ; ACTIVE PROBLEMS

 I $G(DEFEF),$P($G(^VEN(7.41,DEFEF,5)),U,17)>1,$L($T(PCCPLUS^APCHSPRN)) D PCCPLUS^APCHSPRN(DFN,DEFEF) ;  PROBLEM NARRATIVE LOOKUP FOR ANMC

 D POV(DFN) ; ALL RECENT POVS

 N CSIEN

 S CSIEN=$P($G(^VEN(7.95,DEPTIEN,0)),U,4) I 'CSIEN Q

 D CSPOV(DFN,CSIEN) ; CLINIC SPECIFIC POVS

 Q

 ; 

APL(DFN) ; EP-GET UP TO 25 ACTIVE PROBLEMS STORED IN pb1-pb25 AND CODES IN pb1c-pb25c

 NEW TOT,PIEN,X,NIEN,IIEN,STAT,TYPE,NARR,VAR,VAR1,ICD,MAXNARR

 S TOT=0,PIEN=0,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))

 F  S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN  D  I TOT>24 Q

 . S X=$G(^AUPNPROB(PIEN,0)),NIEN=$P(X,U,5),IIEN=+X,STAT=$P(X,U,12),TYPE=$P(X,4,U)

 . I NIEN,IIEN,STAT="A",TYPE=""

 . E  Q

 . S NARR=$G(^AUTNPOV(NIEN,0)),ICD=$P($G(^ICD9(IIEN,0)),U),ICD9(IIEN)=""

 . S TOT=TOT+1

 . S VAR="pb"_TOT,VAR1=VAR_"c"

 . S @TMP@(1,VAR)=$E(NARR,1,MAXNARR),@TMP@(1,VAR1)=ICD

 . Q

 Q

 ; 

POV(DFN) ; EP-GET UP TO 30 MOST RECENT POVS

 ; DATA STORED IN MAIL MERGE FIELD PAIRS pv1 - pv30

 N PIEN,X,NIEN,IIEN,TOT,NARR,VAR,VAR1,ICD,DATE,Y,VISIT,MAXNARR,VCN

 S TOT=0,PIEN=999999999,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))

 F  S PIEN=$O(^AUPNVPOV("AC",DFN,PIEN),-1) Q:'PIEN  D  I TOT>29 Q

 . S VISIT=$P($G(^AUPNVPOV(PIEN,0)),U,3) I 'VISIT Q

 . S Y=+$G(^AUPNVSIT(VISIT,0))

 . S DATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)  I '$L(DATE) Q

 . S X=$G(^AUPNVPOV(PIEN,0)),NIEN=$P(X,U,4),IIEN=+X

 . S NARR=$G(^AUTNPOV(+$G(NIEN),0)),ICD=$$FVICD^VENPCCU(PIEN)

 . I '$L(NARR) S NARR=$P($G(^ICD9(IIEN,0)),U,3) I '$L(NARR) S NARR="<missing narrative>"

 . S TOT=TOT+1

 . S VAR1="pv"_TOT

 . S VCN="" ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2

 . I $P($G(^VEN(7.41,+$G(DEFEF),5)),U,21) S %=$P($G(^AUPNVSIT(VISIT,11)),U,3) I $L(%) S VCN=" "_%

 . S @TMP@(1,VAR1)=DATE_" "_$E(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN

 . Q

 Q

 ; 

CSPOV(DFN,CSIEN) ; EP-GET UP TO 30 MOST RECENT POVS FOR THIS CLINIC

 ; DATA STORED IN MAIL MERGE FIELD  pv1C THRU pv30C

 N PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR,VCN

 S TOT=0,PIEN=999999999,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))

 F  S PIEN=$O(^AUPNVPOV("AC",DFN,PIEN),-1) Q:'PIEN  D  I TOT>29 Q

 . S VISIT=$P($G(^AUPNVPOV(PIEN,0)),U,3) I 'VISIT Q

 . S VCS=$P($G(^AUPNVSIT(VISIT,0)),U,8) I VCS'=CSIEN Q  ; CLINIC STOP FILTER

 . S Y=+$G(^AUPNVSIT(VISIT,0)) I '$L(Y) Q

 . S DATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)

 . S X=$G(^AUPNVPOV(PIEN,0)),NIEN=$P(X,U,4),IIEN=+X

 . S NARR=$G(^AUTNPOV(+$G(NIEN),0)),ICD=$$FVICD^VENPCCU(PIEN)

 . I '$L(NARR) S NARR=$P($G(^ICD9(IIEN,0)),U,3) I '$L(NARR) S NARR="<missing narrative>"

 . S TOT=TOT+1

 . S VAR="pv"_TOT_"c"

 . S VCN="" ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2

 . I $P($G(^VEN(7.41,+$G(DEFEF),5)),U,21) S %=$P($G(^AUPNVSIT(VISIT,11)),U,3) I $L(%) S VCN=" "_%

 . S @TMP@(1,VAR)=DATE_" "_$E(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN

 . Q

 Q

 ; 

MH(DFN) ; EP-GET 15 MOST RECENT MENTAL HEALTH VISITS

 ; DATA IS STORED IN mh1-mh15

 N PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR

 S TOT=0,PIEN=999999999,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))

 F  S PIEN=$O(^AUPNVPOV("AC",DFN,PIEN),-1) Q:'PIEN  D  I TOT>14 Q

 . S VISIT=$P($G(^AUPNVPOV(PIEN,0)),U,3) I 'VISIT Q

 . S Y=+$G(^AUPNVSIT(VISIT,0))

 . S DATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) I '$L(DATE) Q

 . S X=$G(^AUPNVPOV(PIEN,0)),NIEN=$P(X,U,4),IIEN=+X I 'IIEN Q

 . S ICD=$$FVICD^VENPCCU(PIEN) I '$L(ICD) Q

 . I +ICD<290!(+ICD>319.999999) Q  ; FILTER OUT NON MENTAL HEALTH DXS

 . S NARR=$G(^AUTNPOV(+$G(NIEN),0))

 . I '$L(NARR) S NARR=$P($G(^ICD9(IIEN,0)),U,3) I '$L(NARR) S NARR="<missing narrative>"

 . S NARR=NARR

 . S TOT=TOT+1

 . S VAR="mh"_TOT

 . S @TMP@(1,VAR)=DATE_" "_$E(NARR,1,MAXNARR)_" ["_ICD_"]"

 . Q

 Q

 ; 

ORLOG(DFN) ; EP-SURGERY HX BASED ON ANMC OR LOG

 ; FOR ANMC ONLY

 I '$D(^AZAORM(1,+$G(DFN),1)) Q "" ; MUST HAVE A VALID DFN

 N DN,SN,PN,DATE,TOT,SURGEON,PNARR,ICD,DATE,X,Y,%,GBL,OUT,SIEN,STG

 S GBL="^AZAORM(1,"_DFN_",1)",TOT=0,DN=999999999,OUT=""

 F  S DN=$O(@GBL@(DN),-1) Q:'DN  D

 . S Y=$P($G(@GBL@(DN,0)),U)\1 I 'Y Q

 . X ^DD("DD") S DATE=Y

 . S SN=0

 . F  S SN=$O(@GBL@(DN,1,SN)) Q:'SN  D

 .. S SIEN=+$G(@GBL@(DN,1,SN,0)) I 'SIEN Q

 .. S %=U_"DIC("_16_")",SURGEON=$P($G(@%@(SIEN,0)),U) I '$L(SURGEON) Q

 .. S PN=0

 .. F  S PN=$O(@GBL@(DN,1,SN,4,PN)) Q:'PN  D

 ... S STG=$G(@GBL@(DN,1,SN,4,PN,0)) I '$L(STG) Q

 ... S PNARR=$P(STG,U) I '$L(PNARR) Q

 ... S %=$P(STG,U,2)

 ... S ICD=$P($G(^ICD0(+%,0)),U)

 ... S TOT=TOT+1

 ... S $P(OUT,U,TOT)=(DATE_";"_PNARR_";"_ICD_";"_SURGEON)

 ... Q

 .. Q

 . Q

 Q OUT

 ;

SURG(DFN,DEFEF) ; EP - PRINT THE SURGICAL HX FROM THE OR LOG ON THE PCC+ FORM IN MERGE FIELDS u1-u15

 ; FOR ANMC ONLY

 I '$D(^AZAORM(1,+$G(DFN))) Q  ; MUST HAVE A VILD ER LOG DFN

 N VAR,STG,X,Y,%,TOT,CASE,I,MAX

 S STG=$$ORLOG(DFN) I '$L(STG) Q

 S MAX=$L(STG,U) I MAX>15 S MAX=15

 F TOT=1:1:MAX S CASE=$P(STG,U,TOT) I $L(CASE) D

 . S X=$P(CASE,";")_" "_$P(CASE,";",2) ; PRINT DATE AND PROCEDURE NARRATIVE

 . I $P($G(^VEN(7.41,DEFEF,5)),U,19) S X=X_" "_$P(CASE,";",3) ; PRINT THE ICD PROCEDURE CODE

 . I $P($G(^VEN(7.41,DEFEF,5)),U,20) S Y=$P(CASE,";"),X=X_" DR. "_$E($P(Y,",",2))_". "_$P(Y,",") ; PRINT THE SURGEON

 . S VAR="u"_TOT

 . S @TMP@(1,VAR)=X

 . Q

 Q

 ;

VENPCC1K  ; IHS/OIT/GIS - SPECIAL DISPLAY OF PROBLEMS AND POVS ; 

 +1       ;;2.6;PCC+;;NOV 12, 2007

 +2       ;

 +3       ; SPECIAL PROBLEM DISPLAY FOR VER 2.5

 +4       ; 

PROB(DFN,DEPTIEN) ; EP - SPECIAL PROBLEM DISPLAY

 +1        NEW TMP

 +2        SET TMP="^TMP(""VEN PRNT"",$J)"

 +3       ; ACTIVE PROBLEMS

           DO APL(DFN)

 +4       ;  PROBLEM NARRATIVE LOOKUP FOR ANMC

           IF $GET(DEFEF)

               IF $PIECE($GET(^VEN(7.41,DEFEF,5)),U,17)>1

                   IF $LENGTH($TEXT(PCCPLUS^APCHSPRN))

                       DO PCCPLUS^APCHSPRN(DFN,DEFEF)

 +5       ; ALL RECENT POVS

           DO POV(DFN)

 +6        NEW CSIEN

 +7        SET CSIEN=$PIECE($GET(^VEN(7.95,DEPTIEN,0)),U,4)

           IF 'CSIEN

               QUIT 

 +8       ; CLINIC SPECIFIC POVS

           DO CSPOV(DFN,CSIEN)

 +9        QUIT 

 +10      ; 

APL(DFN)  ; EP-GET UP TO 25 ACTIVE PROBLEMS STORED IN pb1-pb25 AND CODES IN pb1c-pb25c

 +1        NEW TOT,PIEN,X,NIEN,IIEN,STAT,TYPE,NARR,VAR,VAR1,ICD,MAXNARR

 +2        SET TOT=0

           SET PIEN=0

           SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))

 +3        FOR 

               SET PIEN=$ORDER(^AUPNPROB("AC",DFN,PIEN))

               IF 'PIEN

                   QUIT 

               Begin DoDot:1

 +4                SET X=$GET(^AUPNPROB(PIEN,0))

                   SET NIEN=$PIECE(X,U,5)

                   SET IIEN=+X

                   SET STAT=$PIECE(X,U,12)

                   SET TYPE=$PIECE(X,4,U)

 +5                IF NIEN

                       IF IIEN

                           IF STAT="A"

                               IF TYPE=""

 +6               IF '$TEST

                       QUIT 

 +7                SET NARR=$GET(^AUTNPOV(NIEN,0))

                   SET ICD=$PIECE($GET(^ICD9(IIEN,0)),U)

                   SET ICD9(IIEN)=""

 +8                SET TOT=TOT+1

 +9                SET VAR="pb"_TOT

                   SET VAR1=VAR_"c"

 +10               SET @TMP@(1,VAR)=$EXTRACT(NARR,1,MAXNARR)

                   SET @TMP@(1,VAR1)=ICD

 +11               QUIT 

               End DoDot:1

               IF TOT>24

                   QUIT 

 +12       QUIT 

 +13      ; 

POV(DFN)  ; EP-GET UP TO 30 MOST RECENT POVS

 +1       ; DATA STORED IN MAIL MERGE FIELD PAIRS pv1 - pv30

 +2        NEW PIEN,X,NIEN,IIEN,TOT,NARR,VAR,VAR1,ICD,DATE,Y,VISIT,MAXNARR,VCN

 +3        SET TOT=0

           SET PIEN=999999999

           SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))

 +4        FOR 

               SET PIEN=$ORDER(^AUPNVPOV("AC",DFN,PIEN),-1)

               IF 'PIEN

                   QUIT 

               Begin DoDot:1

 +5                SET VISIT=$PIECE($GET(^AUPNVPOV(PIEN,0)),U,3)

                   IF 'VISIT

                       QUIT 

 +6                SET Y=+$GET(^AUPNVSIT(VISIT,0))

 +7                SET DATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)

                   IF '$LENGTH(DATE)

                       QUIT 

 +8                SET X=$GET(^AUPNVPOV(PIEN,0))

                   SET NIEN=$PIECE(X,U,4)

                   SET IIEN=+X

 +9                SET NARR=$GET(^AUTNPOV(+$GET(NIEN),0))

                   SET ICD=$$FVICD^VENPCCU(PIEN)

 +10               IF '$LENGTH(NARR)

                       SET NARR=$PIECE($GET(^ICD9(IIEN,0)),U,3)

                       IF '$LENGTH(NARR)

                           SET NARR="<missing narrative>"

 +11               SET TOT=TOT+1

 +12               SET VAR1="pv"_TOT

 +13      ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2

                   SET VCN=""

 +14               IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),5)),U,21)

                       SET %=$PIECE($GET(^AUPNVSIT(VISIT,11)),U,3)

                       IF $LENGTH(%)

                           SET VCN=" "_%

 +15               SET @TMP@(1,VAR1)=DATE_" "_$EXTRACT(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN

 +16               QUIT 

               End DoDot:1

               IF TOT>29

                   QUIT 

 +17       QUIT 

 +18      ; 

CSPOV(DFN,CSIEN) ; EP-GET UP TO 30 MOST RECENT POVS FOR THIS CLINIC

 +1       ; DATA STORED IN MAIL MERGE FIELD  pv1C THRU pv30C

 +2        NEW PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR,VCN

 +3        SET TOT=0

           SET PIEN=999999999

           SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))

 +4        FOR 

               SET PIEN=$ORDER(^AUPNVPOV("AC",DFN,PIEN),-1)

               IF 'PIEN

                   QUIT 

               Begin DoDot:1

 +5                SET VISIT=$PIECE($GET(^AUPNVPOV(PIEN,0)),U,3)

                   IF 'VISIT

                       QUIT 

 +6       ; CLINIC STOP FILTER

                   SET VCS=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,8)

                   IF VCS'=CSIEN

                       QUIT 

 +7                SET Y=+$GET(^AUPNVSIT(VISIT,0))

                   IF '$LENGTH(Y)

                       QUIT 

 +8                SET DATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)

 +9                SET X=$GET(^AUPNVPOV(PIEN,0))

                   SET NIEN=$PIECE(X,U,4)

                   SET IIEN=+X

 +10               SET NARR=$GET(^AUTNPOV(+$GET(NIEN),0))

                   SET ICD=$$FVICD^VENPCCU(PIEN)

 +11               IF '$LENGTH(NARR)

                       SET NARR=$PIECE($GET(^ICD9(IIEN,0)),U,3)

                       IF '$LENGTH(NARR)

                           SET NARR="<missing narrative>"

 +12               SET TOT=TOT+1

 +13               SET VAR="pv"_TOT_"c"

 +14      ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2

                   SET VCN=""

 +15               IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),5)),U,21)

                       SET %=$PIECE($GET(^AUPNVSIT(VISIT,11)),U,3)

                       IF $LENGTH(%)

                           SET VCN=" "_%

 +16               SET @TMP@(1,VAR)=DATE_" "_$EXTRACT(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN

 +17               QUIT 

               End DoDot:1

               IF TOT>29

                   QUIT 

 +18       QUIT 

 +19      ; 

MH(DFN)   ; EP-GET 15 MOST RECENT MENTAL HEALTH VISITS

 +1       ; DATA IS STORED IN mh1-mh15

 +2        NEW PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR

 +3        SET TOT=0

           SET PIEN=999999999

           SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))

 +4        FOR 

               SET PIEN=$ORDER(^AUPNVPOV("AC",DFN,PIEN),-1)

               IF 'PIEN

                   QUIT 

               Begin DoDot:1

 +5                SET VISIT=$PIECE($GET(^AUPNVPOV(PIEN,0)),U,3)

                   IF 'VISIT

                       QUIT 

 +6                SET Y=+$GET(^AUPNVSIT(VISIT,0))

 +7                SET DATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)

                   IF '$LENGTH(DATE)

                       QUIT 

 +8                SET X=$GET(^AUPNVPOV(PIEN,0))

                   SET NIEN=$PIECE(X,U,4)

                   SET IIEN=+X

                   IF 'IIEN

                       QUIT 

 +9                SET ICD=$$FVICD^VENPCCU(PIEN)

                   IF '$LENGTH(ICD)

                       QUIT 

 +10      ; FILTER OUT NON MENTAL HEALTH DXS

                   IF +ICD<290!(+ICD>319.999999)

                       QUIT 

 +11               SET NARR=$GET(^AUTNPOV(+$GET(NIEN),0))

 +12               IF '$LENGTH(NARR)

                       SET NARR=$PIECE($GET(^ICD9(IIEN,0)),U,3)

                       IF '$LENGTH(NARR)

                           SET NARR="<missing narrative>"

 +13               SET NARR=NARR

 +14               SET TOT=TOT+1

 +15               SET VAR="mh"_TOT

 +16               SET @TMP@(1,VAR)=DATE_" "_$EXTRACT(NARR,1,MAXNARR)_" ["_ICD_"]"

 +17               QUIT 

               End DoDot:1

               IF TOT>14

                   QUIT 

 +18       QUIT 

 +19      ; 

ORLOG(DFN) ; EP-SURGERY HX BASED ON ANMC OR LOG

 +1       ; FOR ANMC ONLY

 +2       ; MUST HAVE A VALID DFN

           IF '$DATA(^AZAORM(1,+$GET(DFN),1))

               QUIT ""

 +3        NEW DN,SN,PN,DATE,TOT,SURGEON,PNARR,ICD,DATE,X,Y,%,GBL,OUT,SIEN,STG

 +4        SET GBL="^AZAORM(1,"_DFN_",1)"

           SET TOT=0

           SET DN=999999999

           SET OUT=""

 +5        FOR 

               SET DN=$ORDER(@GBL@(DN),-1)

               IF 'DN

                   QUIT 

               Begin DoDot:1

 +6                SET Y=$PIECE($GET(@GBL@(DN,0)),U)\1

                   IF 'Y

                       QUIT 

 +7                XECUTE ^DD("DD")

                   SET DATE=Y

 +8                SET SN=0

 +9                FOR 

                       SET SN=$ORDER(@GBL@(DN,1,SN))

                       IF 'SN

                           QUIT 

                       Begin DoDot:2

 +10                       SET SIEN=+$GET(@GBL@(DN,1,SN,0))

                           IF 'SIEN

                               QUIT 

 +11                       SET %=U_"DIC("_16_")"

                           SET SURGEON=$PIECE($GET(@%@(SIEN,0)),U)

                           IF '$LENGTH(SURGEON)

                               QUIT 

 +12                       SET PN=0

 +13                       FOR 

                               SET PN=$ORDER(@GBL@(DN,1,SN,4,PN))

                               IF 'PN

                                   QUIT 

                               Begin DoDot:3

 +14                               SET STG=$GET(@GBL@(DN,1,SN,4,PN,0))

                                   IF '$LENGTH(STG)

                                       QUIT 

 +15                               SET PNARR=$PIECE(STG,U)

                                   IF '$LENGTH(PNARR)

                                       QUIT 

 +16                               SET %=$PIECE(STG,U,2)

 +17                               SET ICD=$PIECE($GET(^ICD0(+%,0)),U)

 +18                               SET TOT=TOT+1

 +19                               SET $PIECE(OUT,U,TOT)=(DATE_";"_PNARR_";"_ICD_";"_SURGEON)

 +20                               QUIT 

                               End DoDot:3

 +21                       QUIT 

                       End DoDot:2

 +22               QUIT 

               End DoDot:1

 +23       QUIT OUT

 +24      ;

SURG(DFN,DEFEF) ; EP - PRINT THE SURGICAL HX FROM THE OR LOG ON THE PCC+ FORM IN MERGE FIELDS u1-u15

 +1       ; FOR ANMC ONLY

 +2       ; MUST HAVE A VILD ER LOG DFN

           IF '$DATA(^AZAORM(1,+$GET(DFN)))

               QUIT 

 +3        NEW VAR,STG,X,Y,%,TOT,CASE,I,MAX

 +4        SET STG=$$ORLOG(DFN)

           IF '$LENGTH(STG)

               QUIT 

 +5        SET MAX=$LENGTH(STG,U)

           IF MAX>15

               SET MAX=15

 +6        FOR TOT=1:1:MAX

               SET CASE=$PIECE(STG,U,TOT)

               IF $LENGTH(CASE)

                   Begin DoDot:1

 +7       ; PRINT DATE AND PROCEDURE NARRATIVE

                       SET X=$PIECE(CASE,";")_" "_$PIECE(CASE,";",2)

 +8       ; PRINT THE ICD PROCEDURE CODE

                       IF $PIECE($GET(^VEN(7.41,DEFEF,5)),U,19)

                           SET X=X_" "_$PIECE(CASE,";",3)

 +9       ; PRINT THE SURGEON

                       IF $PIECE($GET(^VEN(7.41,DEFEF,5)),U,20)

                           SET Y=$PIECE(CASE,";")

                           SET X=X_" DR. "_$EXTRACT($PIECE(Y,",",2))_". "_$PIECE(Y,",")

 +10                   SET VAR="u"_TOT

 +11                   SET @TMP@(1,VAR)=X

 +12                   QUIT 

                   End DoDot:1

 +13       QUIT 

 +14      ;