MDPCE2 ; HOIFO/NCA - Routine For Data Extract For Hemo Dialysis ;Sep 24, 2021@12:35
 ;;1.0;CLINICAL PROCEDURES;**6,21,29,80**;Apr 01, 2004;Build 3
 ; Integration Agreements:
 ; IA# 1889 [Subscription] Create New Visit - DATA2PCE^PXAPI call
 ;     1890 [Subscription] Delete existing visit - DELVFILE^PXAPI call
 ;     1995 [Supported] ICPTCOD API Call
 ;     5699 [Supported] ICDDATA^ICDXCODE calls
 ;    10040 [Supported] Hospital Location File Access
 ;    10048 [Supported] FILE 9.4 references
 ;    10103 [Supported] XLFDT calls
 ;
EN1(MDENC,MDINST,MDPDTE,MDPR,MDTYP,MDETYP,MDCLOC) ; [Function] PCE Visit Creation
 ; Input parameters
 ;  1. MDENC [Literal/Required] Billing data array
 ;  2. MDINST [Literal/Required] Transaction IEN
 ;  3. MDPDTE [Literal/Optional] Procedure Date/Time
 ;  4. MDPR [Literal/Required] CP Definition
 ;  5. MDTYP [Literal/Required] Type of Visit (Ambulatory or Hospitalization)
 ;  6. MDETYP [Literal/Required] Encounter Type (Primary or Ancillary)
 ;  7. MDCLOC [Literal/Required] Workload Reporting hospital location
 ;
 N DATA,DIAG,MDCCOD,MDICDINFO,MDCLIN,MDCLL,MDDESC,MDPERR,MDJ,MDK,MDL,MDLST,MDM,MDNOD,MDOK,MDOK1,MDOK2,MDPKG,MDPROV,MDRES,MDSC,MDSTR,MDV1,MDVISIT,MDDRES K ^TMP("MDPXAPI",$J)
 S MDOUT="",(MDOK,MDOK1,MDOK2,MDSC)=0
 S MDPKG=$$FIND1^DIC(9.4,"","MX","CLINICAL PROCEDURES")
 I 'MDPKG Q "-1^CLINICAL PROCEDURES does not exist in Package File."
 I '$D(^MDD(702,MDINST,0)) Q "-1^No Study Record."
 S MDSTR=$G(^MDD(702,MDINST,0))
 S MDCLIN=$G(^MDD(702,MDINST,1))
 S MDRES=""
 I +$P(MDCLIN,U) S MDRES=$$DELVFILE^PXAPI("PRV^POV^CPT",+$P(MDCLIN,U),"","CLINICAL PROCEDURES") S MDVISIT=+MDCLIN
 ;I +MDRES<0 Q $P(MDRES,"^")_"^Cannot purge existing visit during PCE data set."
 S (MDJ,MDK,MDL,MDM)=0,MDJ=MDJ+1,MDPROV=""
 I '$G(MDCLOC) S MDCLOC=$$GET1^DIQ(702.01,+MDPR_",",.05,"I") I 'MDCLOC Q "-1^No Hospital Location for CP Definition."
 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"ENC D/T")=MDPDTE
 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"PATIENT")=$P(MDSTR,"^",1)
 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"HOS LOC")=MDCLOC
 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"SERVICE CATEGORY")=$S(MDTYP="V":"A",1:MDTYP)
 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"ENCOUNTER TYPE")=MDETYP
 I $$GET1^DIQ(44,MDCLOC_",",3,"I") S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"INSTITUTION")=$$GET1^DIQ(44,MDCLOC_",",3,"I")
 S MDLST="" F  S MDLST=$O(MDENC(MDLST)) Q:MDLST=""  S MDNOD=$G(MDENC(MDLST)) D
 .I $P(MDNOD,"^")["SC" D  Q
 ..S:+$P(MDNOD,";",2) ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"SC")=+$P($P(MDNOD,";",2),U,2) S:+$P($P(MDNOD,";",2),U,2)>0 MDSC=1
 ..I $P(MDNOD,";",3)="AO" Q:+MDSC>0  S:+$P(MDNOD,";",4) ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"AO")=+$P($P(MDNOD,";",4),"^",2)
 ..I $P(MDNOD,";",5)="IR" Q:+MDSC>0  S:+$P(MDNOD,";",6) ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"IR")=+$P($P(MDNOD,";",6),"^",2)
 ..I $P(MDNOD,";",7)="EC" Q:+MDSC>0  S:+$P(MDNOD,";",8) ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"EC")=+$P($P(MDNOD,";",8),"^",2)
 ..I $P(MDNOD,";",9)="MST" Q:+MDSC>0  S:+$P(MDNOD,";",10) ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"MST")=+$P($P(MDNOD,";",10),"^",2)
 ..I $P(MDNOD,";",11)="HNC" Q:+MDSC>0  S:+$P(MDNOD,";",12) ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"HNC")=+$P($P(MDNOD,";",12),"^",2)
 ..I $P(MDNOD,";",13)="CV" Q:+MDSC>0  S:+$P(MDNOD,";",14) ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"CV")=+$P($P(MDNOD,";",14),"^",2)
 .I $P(MDNOD,"^")="PRV" I $P(MDNOD,"^",2)'="" D  Q
 ..S MDK=MDK+1,^TMP("MDPXAPI",$J,"PROVIDER",MDK,"NAME")=$P(MDNOD,"^",2) S:'MDOK MDOK=1
 ..S ^TMP("MDPXAPI",$J,"PROVIDER",MDK,"PRIMARY")=$P(MDNOD,"^",6)
 ..S:MDPROV="" MDPROV=$P(MDNOD,"^",2)
 ..Q
 .I $P(MDNOD,"^")="POV" D  Q
 ..Q:$P(MDNOD,"^",3)=""
 ..S MDICDINFO=$$ICDDATA^ICDXCODE(80,$P(MDNOD,"^",3),MDPDTE)
 ..S MDCCOD=MDICDINFO S MDCCOD=+$P(MDCCOD,"^") Q:+MDCCOD<1
 ..S MDL=MDL+1,^TMP("MDPXAPI",$J,"DX/PL",MDL,"DIAGNOSIS")=MDCCOD
 ..S ^TMP("MDPXAPI",$J,"DX/PL",MDL,"PRIMARY")=$P(MDNOD,"^",6)
 ..S ^TMP("MDPXAPI",$J,"DX/PL",MDL,"ORD/RES")="R"
 ..S ^TMP("MDPXAPI",$J,"DX/PL",MDL,"CATEGORY")=$P(MDNOD,"^",4)
 ..S DIAG=MDICDINFO
 ..S ^TMP("MDPXAPI",$J,"DX/PL",MDL,"NARRATIVE")=$P(DIAG,"^",4)
 ..S:MDPROV ^TMP("MDPXAPI",$J,"DX/PL",MDL,"ENC PROVIDER")=MDPROV
 ..S:'MDOK1 MDOK1=1
 .I $P(MDNOD,"^")="CPT" D  Q
 ..Q:$P(MDNOD,U,3)=""
 ..S MDCCOD=$$CPT^ICPTCOD($P(MDNOD,U,3)) Q:+MDCCOD<1
 ..S MDM=MDM+1 S:'MDOK2 MDOK2=1
 ..S MDDESC="",MDDESC=$P(MDNOD,"^",5)
 ..S:$L(MDDESC)>230 MDDESC=$E(MDDESC,1,230)
 ..S:MDDESC="" MDDESC=$P(MDCCOD,"^",3)
 ..S ^TMP("MDPXAPI",$J,"PROCEDURE",MDM,"PROCEDURE")=$P(MDCCOD,"^")
 ..S ^TMP("MDPXAPI",$J,"PROCEDURE",MDM,"NARRATIVE")=MDDESC
 ..S ^TMP("MDPXAPI",$J,"PROCEDURE",MDM,"CATEGORY")=$P(MDNOD,"^",4)
 ..S ^TMP("MDPXAPI",$J,"PROCEDURE",MDM,"QTY")=$P(MDNOD,"^",7)
 ..S:MDPROV ^TMP("MDPXAPI",$J,"PROCEDURE",MDM,"ENC PROVIDER")=MDPROV
 I (MDOK+MDOK1+MDOK2)=3 S ^TMP("MDPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=$$NOW^XLFDT
 ;MD*1.0*80: If DUZ not defined, zero, not numeric, or null,
 ;           send DUZ for proxy service. (Considered also validating
 ;           whether a numeric DUZ sent in by upstream logic exists
 ;           in file 200. If a numeric DUZ is not in file 200, PCE
 ;           will send back a processing error of "not a valid pointer
 ;           to the New Person file #200". This might indicate a
 ;           configuration issue which the site needs to be aware of.
 ;           Since PCE performs this validation, there shouldn't be a
 ;           need for MDPCE* routines to.)
 S MDRES=$$DATA2PCE^PXAPI("^TMP(""MDPXAPI"",$J)",MDPKG,"CLINICAL PROCEDURES",.MDVISIT,$S('$G(DUZ):$$FINDD^MDPCE(),1:""),"",1,"",.MDPERR)
 I MDRES<1 D  Q MDOUT
 .S MDOUT=1
 .I MDVISIT>0 S MDFDA(702,MDINST_",",.13)=MDVISIT,MDOUT=MDVISIT_"^"_MDCLOC_";"_MDPDTE_";"_MDTYP,MDFDA(702,MDINST_",",.07)=MDTYP_";"_MDPDTE_";"_MDCLOC D FILE^DIE("K","MDFDA")
 .K ^TMP("MDPXAPI",$J) Q
 S:MDVISIT>0 MDFDA(702,MDINST_",",.13)=MDVISIT
 S MDOUT=MDVISIT_"^"_MDCLOC_";"_MDPDTE_";"_MDTYP
 S MDFDA(702,MDINST_",",.07)=MDTYP_";"_MDPDTE_";"_MDCLOC
 D FILE^DIE("K","MDFDA") K ^TMP("MDPXAPI",$J)
 Q MDOUT
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPCE2   6048     printed  Sep 23, 2025@19:19:07                                                                                                                                                                                                      Page 2
MDPCE2    ; HOIFO/NCA - Routine For Data Extract For Hemo Dialysis ;Sep 24, 2021@12:35
 +1       ;;1.0;CLINICAL PROCEDURES;**6,21,29,80**;Apr 01, 2004;Build 3
 +2       ; Integration Agreements:
 +3       ; IA# 1889 [Subscription] Create New Visit - DATA2PCE^PXAPI call
 +4       ;     1890 [Subscription] Delete existing visit - DELVFILE^PXAPI call
 +5       ;     1995 [Supported] ICPTCOD API Call
 +6       ;     5699 [Supported] ICDDATA^ICDXCODE calls
 +7       ;    10040 [Supported] Hospital Location File Access
 +8       ;    10048 [Supported] FILE 9.4 references
 +9       ;    10103 [Supported] XLFDT calls
 +10      ;
EN1(MDENC,MDINST,MDPDTE,MDPR,MDTYP,MDETYP,MDCLOC) ; [Function] PCE Visit Creation
 +1       ; Input parameters
 +2       ;  1. MDENC [Literal/Required] Billing data array
 +3       ;  2. MDINST [Literal/Required] Transaction IEN
 +4       ;  3. MDPDTE [Literal/Optional] Procedure Date/Time
 +5       ;  4. MDPR [Literal/Required] CP Definition
 +6       ;  5. MDTYP [Literal/Required] Type of Visit (Ambulatory or Hospitalization)
 +7       ;  6. MDETYP [Literal/Required] Encounter Type (Primary or Ancillary)
 +8       ;  7. MDCLOC [Literal/Required] Workload Reporting hospital location
 +9       ;
 +10       NEW DATA,DIAG,MDCCOD,MDICDINFO,MDCLIN,MDCLL,MDDESC,MDPERR,MDJ,MDK,MDL,MDLST,MDM,MDNOD,MDOK,MDOK1,MDOK2,MDPKG,MDPROV,MDRES,MDSC,MDSTR,MDV1,MDVISIT,MDDRES
           KILL ^TMP("MDPXAPI",$JOB)
 +11       SET MDOUT=""
           SET (MDOK,MDOK1,MDOK2,MDSC)=0
 +12       SET MDPKG=$$FIND1^DIC(9.4,"","MX","CLINICAL PROCEDURES")
 +13       IF 'MDPKG
               QUIT "-1^CLINICAL PROCEDURES does not exist in Package File."
 +14       IF '$DATA(^MDD(702,MDINST,0))
               QUIT "-1^No Study Record."
 +15       SET MDSTR=$GET(^MDD(702,MDINST,0))
 +16       SET MDCLIN=$GET(^MDD(702,MDINST,1))
 +17       SET MDRES=""
 +18       IF +$PIECE(MDCLIN,U)
               SET MDRES=$$DELVFILE^PXAPI("PRV^POV^CPT",+$PIECE(MDCLIN,U),"","CLINICAL PROCEDURES")
               SET MDVISIT=+MDCLIN
 +19      ;I +MDRES<0 Q $P(MDRES,"^")_"^Cannot purge existing visit during PCE data set."
 +20       SET (MDJ,MDK,MDL,MDM)=0
           SET MDJ=MDJ+1
           SET MDPROV=""
 +21       IF '$GET(MDCLOC)
               SET MDCLOC=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")
               IF 'MDCLOC
                   QUIT "-1^No Hospital Location for CP Definition."
 +22       SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"ENC D/T")=MDPDTE
 +23       SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"PATIENT")=$PIECE(MDSTR,"^",1)
 +24       SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"HOS LOC")=MDCLOC
 +25       SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"SERVICE CATEGORY")=$SELECT(MDTYP="V":"A",1:MDTYP)
 +26       SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"ENCOUNTER TYPE")=MDETYP
 +27       IF $$GET1^DIQ(44,MDCLOC_",",3,"I")
               SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"INSTITUTION")=$$GET1^DIQ(44,MDCLOC_",",3,"I")
 +28       SET MDLST=""
           FOR 
               SET MDLST=$ORDER(MDENC(MDLST))
               if MDLST=""
                   QUIT 
               SET MDNOD=$GET(MDENC(MDLST))
               Begin DoDot:1
 +29               IF $PIECE(MDNOD,"^")["SC"
                       Begin DoDot:2
 +30                       if +$PIECE(MDNOD,";",2)
                               SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"SC")=+$PIECE($PIECE(MDNOD,";",2),U,2)
                           if +$PIECE($PIECE(MDNOD,";",2),U,2)>0
                               SET MDSC=1
 +31                       IF $PIECE(MDNOD,";",3)="AO"
                               if +MDSC>0
                                   QUIT 
                               if +$PIECE(MDNOD,";",4)
                                   SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"AO")=+$PIECE($PIECE(MDNOD,";",4),"^",2)
 +32                       IF $PIECE(MDNOD,";",5)="IR"
                               if +MDSC>0
                                   QUIT 
                               if +$PIECE(MDNOD,";",6)
                                   SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"IR")=+$PIECE($PIECE(MDNOD,";",6),"^",2)
 +33                       IF $PIECE(MDNOD,";",7)="EC"
                               if +MDSC>0
                                   QUIT 
                               if +$PIECE(MDNOD,";",8)
                                   SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"EC")=+$PIECE($PIECE(MDNOD,";",8),"^",2)
 +34                       IF $PIECE(MDNOD,";",9)="MST"
                               if +MDSC>0
                                   QUIT 
                               if +$PIECE(MDNOD,";",10)
                                   SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"MST")=+$PIECE($PIECE(MDNOD,";",10),"^",2)
 +35                       IF $PIECE(MDNOD,";",11)="HNC"
                               if +MDSC>0
                                   QUIT 
                               if +$PIECE(MDNOD,";",12)
                                   SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"HNC")=+$PIECE($PIECE(MDNOD,";",12),"^",2)
 +36                       IF $PIECE(MDNOD,";",13)="CV"
                               if +MDSC>0
                                   QUIT 
                               if +$PIECE(MDNOD,";",14)
                                   SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",MDJ,"CV")=+$PIECE($PIECE(MDNOD,";",14),"^",2)
                       End DoDot:2
                       QUIT 
 +37               IF $PIECE(MDNOD,"^")="PRV"
                       IF $PIECE(MDNOD,"^",2)'=""
                           Begin DoDot:2
 +38                           SET MDK=MDK+1
                               SET ^TMP("MDPXAPI",$JOB,"PROVIDER",MDK,"NAME")=$PIECE(MDNOD,"^",2)
                               if 'MDOK
                                   SET MDOK=1
 +39                           SET ^TMP("MDPXAPI",$JOB,"PROVIDER",MDK,"PRIMARY")=$PIECE(MDNOD,"^",6)
 +40                           if MDPROV=""
                                   SET MDPROV=$PIECE(MDNOD,"^",2)
 +41                           QUIT 
                           End DoDot:2
                           QUIT 
 +42               IF $PIECE(MDNOD,"^")="POV"
                       Begin DoDot:2
 +43                       if $PIECE(MDNOD,"^",3)=""
                               QUIT 
 +44                       SET MDICDINFO=$$ICDDATA^ICDXCODE(80,$PIECE(MDNOD,"^",3),MDPDTE)
 +45                       SET MDCCOD=MDICDINFO
                           SET MDCCOD=+$PIECE(MDCCOD,"^")
                           if +MDCCOD<1
                               QUIT 
 +46                       SET MDL=MDL+1
                           SET ^TMP("MDPXAPI",$JOB,"DX/PL",MDL,"DIAGNOSIS")=MDCCOD
 +47                       SET ^TMP("MDPXAPI",$JOB,"DX/PL",MDL,"PRIMARY")=$PIECE(MDNOD,"^",6)
 +48                       SET ^TMP("MDPXAPI",$JOB,"DX/PL",MDL,"ORD/RES")="R"
 +49                       SET ^TMP("MDPXAPI",$JOB,"DX/PL",MDL,"CATEGORY")=$PIECE(MDNOD,"^",4)
 +50                       SET DIAG=MDICDINFO
 +51                       SET ^TMP("MDPXAPI",$JOB,"DX/PL",MDL,"NARRATIVE")=$PIECE(DIAG,"^",4)
 +52                       if MDPROV
                               SET ^TMP("MDPXAPI",$JOB,"DX/PL",MDL,"ENC PROVIDER")=MDPROV
 +53                       if 'MDOK1
                               SET MDOK1=1
                       End DoDot:2
                       QUIT 
 +54               IF $PIECE(MDNOD,"^")="CPT"
                       Begin DoDot:2
 +55                       if $PIECE(MDNOD,U,3)=""
                               QUIT 
 +56                       SET MDCCOD=$$CPT^ICPTCOD($PIECE(MDNOD,U,3))
                           if +MDCCOD<1
                               QUIT 
 +57                       SET MDM=MDM+1
                           if 'MDOK2
                               SET MDOK2=1
 +58                       SET MDDESC=""
                           SET MDDESC=$PIECE(MDNOD,"^",5)
 +59                       if $LENGTH(MDDESC)>230
                               SET MDDESC=$EXTRACT(MDDESC,1,230)
 +60                       if MDDESC=""
                               SET MDDESC=$PIECE(MDCCOD,"^",3)
 +61                       SET ^TMP("MDPXAPI",$JOB,"PROCEDURE",MDM,"PROCEDURE")=$PIECE(MDCCOD,"^")
 +62                       SET ^TMP("MDPXAPI",$JOB,"PROCEDURE",MDM,"NARRATIVE")=MDDESC
 +63                       SET ^TMP("MDPXAPI",$JOB,"PROCEDURE",MDM,"CATEGORY")=$PIECE(MDNOD,"^",4)
 +64                       SET ^TMP("MDPXAPI",$JOB,"PROCEDURE",MDM,"QTY")=$PIECE(MDNOD,"^",7)
 +65                       if MDPROV
                               SET ^TMP("MDPXAPI",$JOB,"PROCEDURE",MDM,"ENC PROVIDER")=MDPROV
                       End DoDot:2
                       QUIT 
               End DoDot:1
 +66       IF (MDOK+MDOK1+MDOK2)=3
               SET ^TMP("MDPXAPI",$JOB,"ENCOUNTER",1,"CHECKOUT D/T")=$$NOW^XLFDT
 +67      ;MD*1.0*80: If DUZ not defined, zero, not numeric, or null,
 +68      ;           send DUZ for proxy service. (Considered also validating
 +69      ;           whether a numeric DUZ sent in by upstream logic exists
 +70      ;           in file 200. If a numeric DUZ is not in file 200, PCE
 +71      ;           will send back a processing error of "not a valid pointer
 +72      ;           to the New Person file #200". This might indicate a
 +73      ;           configuration issue which the site needs to be aware of.
 +74      ;           Since PCE performs this validation, there shouldn't be a
 +75      ;           need for MDPCE* routines to.)
 +76       SET MDRES=$$DATA2PCE^PXAPI("^TMP(""MDPXAPI"",$J)",MDPKG,"CLINICAL PROCEDURES",.MDVISIT,$SELECT('$GET(DUZ):$$FINDD^MDPCE(),1:""),"",1,"",.MDPERR)
 +77       IF MDRES<1
               Begin DoDot:1
 +78               SET MDOUT=1
 +79               IF MDVISIT>0
                       SET MDFDA(702,MDINST_",",.13)=MDVISIT
                       SET MDOUT=MDVISIT_"^"_MDCLOC_";"_MDPDTE_";"_MDTYP
                       SET MDFDA(702,MDINST_",",.07)=MDTYP_";"_MDPDTE_";"_MDCLOC
                       DO FILE^DIE("K","MDFDA")
 +80               KILL ^TMP("MDPXAPI",$JOB)
                   QUIT 
               End DoDot:1
               QUIT MDOUT
 +81       if MDVISIT>0
               SET MDFDA(702,MDINST_",",.13)=MDVISIT
 +82       SET MDOUT=MDVISIT_"^"_MDCLOC_";"_MDPDTE_";"_MDTYP
 +83       SET MDFDA(702,MDINST_",",.07)=MDTYP_";"_MDPDTE_";"_MDCLOC
 +84       DO FILE^DIE("K","MDFDA")
           KILL ^TMP("MDPXAPI",$JOB)
 +85       QUIT MDOUT