Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXBAPI1

PXBAPI1.m

Go to the documentation of this file. 
  1. PXBAPI1 ;ISL/JVS,dee - PCE's API - interview questions ;10/15/96
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,23,56,104,111,113,122**;Aug 12, 1996
  1.  ;;
  1.  Q
  1.  ;
  1. PROCESS(PXBEXIT) ;
  1.  I WHAT="INTV" D
  1.  . ;-- Interview is all of the questions
  1.  . D ADQ(.PXBEXIT) I PXBEXIT<1 Q
  1. 1 . D PRV(.PXBEXIT) I PXBEXIT<1 Q
  1. 3 . D POV(.PXBEXIT) I PXBEXIT<1 Q
  1. 2 . D CPT(.PXBEXIT) I PXBEXIT<1 Q
  1.  . I $P($G(^AUPNVSIT($G(PXBVST),150)),"^",3)="O" S PXBEXIT=0 Q
  1.  . I '$$DISPOSIT^PXUTL1($G(PXBPAT),$P($G(^AUPNVSIT(PXBVST,0)),"^",1),$G(PXBVST)) D STP(.PXBEXIT) I PXBEXIT<1 Q
  1.  E  I WHAT="ADDEDIT" D
  1.  . D ADDEDIT
  1.  E  I WHAT="ADQ" D
  1.  . ;-- Adminstrative questions
  1.  . D ADQ(.PXBEXIT)
  1.  E  I WHAT="CODT" D
  1.  . ;-- Check out Date/Time
  1.  . D CODT(.PXBEXIT)
  1.  . Q:PXBEXIT<1
  1.  . D VISIT(.PXBEXIT)
  1.  . I PXBVST'>0 S PXBEXIT=-2 Q
  1.  E  I WHAT="SCC" D
  1.  . ;-- Service connected conditions
  1.  . D SCC(.PXBEXIT)
  1.  . Q:PXBEXIT<1
  1.  . D VISIT(.PXBEXIT)
  1.  . I PXBVST'>0 S PXBEXIT=-2 Q
  1.  E  I WHAT="PRV" D
  1.  . ;-- Providers
  1.  . D PRV(.PXBEXIT)
  1.  E  I WHAT="CPT" D
  1.  . ;-- Providers and CPT codes
  1.  . D CPT(.PXBEXIT)
  1.  E  I WHAT="POV" D
  1.  . ;-- Diagnoses
  1.  . D POV(.PXBEXIT)
  1.  E  I WHAT="STP" D
  1.  . ;-- Stop Codes
  1.  . D STP(.PXBEXIT)
  1.  E  S PXBEXIT=-3 W !,"Procedure ""INTV^PXAPI"" was called incorrectly, contact IRM."
  1.  Q
  1.  ;
  1. ADDEDIT ;
  1.  N ANS
  1. ADDEDIT1 ;
  1.  D ADQ(.PXBEXIT)
  1.  G:PXBEXIT<1 ADDEDIT2
  1.  D PRV(.PXBEXIT)
  1.  G:PXBEXIT<1 ADDEDIT2
  1.  D POV(.PXBEXIT)
  1.  G:PXBEXIT<1 ADDEDIT2
  1.  ;
  1.  ;Call to CPT is not determined by a credit stop code any more
  1.  ;
  1.  D CPT(.PXBEXIT)
  1.  G:PXBEXIT<1 ADDEDIT2
  1. ADDEDIT2 ;
  1.  I PXBVST>0,'$D(^AUPNVCPT("AD",PXBVST)),'$D(^AUPNVSIT("AD",PXBVST)) D  I ANS'=1 S PXBEXIT=1 G ADDEDIT1
  1.  . N DIR,X,Y
  1.  . W !!
  1.  . S DIR(0)="Y"
  1.  . S DIR("A",1)="Must have a STOP CODE or a PROCEDURE to complete this action."
  1.  . S DIR("A")="Do you want to delete this encounter"
  1.  . S DIR("B")="NO"
  1.  . D ^DIR
  1.  . S ANS=Y
  1.  . Q:ANS'=1
  1.  . I $$DELVFILE^PXAPIDEL("ALL",PXBVST,"","","","","")=1 S PXBEXIT=-1
  1.  I PXBVST>0,'$D(^AUPNVSIT(PXBVST,0)) S PXBVST=""
  1.  Q
  1.  ;
  1. ADQ(PXBEXIT) ;Ask the Administration questions
  1.  I PXBVST'>0 D
  1.  . ;This is only done for new visits
  1.  . I PXBPAT'>0 S PXBPAT=$$ASKPAT I PXBPAT'>0 S PXBEXIT=-1 Q
  1.  . S DFN=PXBPAT
  1.  . I PXBHLOC'>0 S PXBHLOC=$$ASKHL I PXBHLOC'>0 S PXBEXIT=-1 Q
  1.  . S PXBVSTDT=$S(PXBAPPT>0:PXBAPPT,1:$$ASKDT) I PXBVSTDT'>0 S PXBEXIT=-1 Q
  1.  . I PXBAPPT'>0&PXBHLOC'=+$G(^DPT(PXBPAT,"S",PXBVSTDT,0)) D
  1.  .. ;This is only done if there is no appointment.
  1.  .. S PXELAP=$$ELAP^SDPCE(PXBPAT,PXBHLOC)
  1.  I PXBEXIT'<1,PXBHLOC'>0 S PXBHLOC=$$ASKHL I PXBHLOC'>0 S PXBEXIT=-1 Q
  1.  I PXBEXIT'<1 D CODT(.PXBEXIT)
  1.  I PXBEXIT'<1 D SCC(.PXBEXIT)
  1.  I PXBEXIT'<1 D
  1.  . D VISIT(.PXBEXIT)
  1.  . I PXBVST'>0 S PXBEXIT=-2 Q
  1.  Q
  1.  ;
  1. ASKPAT() ;Ask user for a patient
  1.  ;DIC on file 9000001
  1.  N DIR,DIC,Y,X,DA
  1.  S DIR(0)="P^9000001:AEMQ"
  1.  S DIR("A")="Patient Name"
  1.  D ^DIR
  1.  Q $S(+Y>0:+Y,1:-1)
  1.  ;
  1. ASKHL() ;Ask user for a Hospital Location
  1. ASKHL2 ;DIC on file 44
  1.  N DIR,DIC,Y,X,DA
  1.  S DIR(0)="PA^44:AEMQ"
  1.  S DIR("A")="Clinic: "
  1.  ; not occasion of service and not dispositioning
  1.  I PXALHLOC S DIR("S")="I '+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))"
  1.  ; only clinic that are not occasion of service and not dispositioning
  1.  E  S DIR("S")="I $P(^(0),U,3)=""C""&'+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))"
  1.  D ^DIR
  1.  I $D(^PX(815,1,"DHL","B",+Y)) D HELPDISP^PXCEVSIT W !,$C(7) G ASKHL2
  1.  Q $S(+Y>0:+Y,1:-1)
  1.  ;
  1. ASKDT() ;Ask user for the encounter Date/Time
  1.  N DIR,Y,X,DA
  1.  S DIR(0)="D^"_$S(PXLIMDT>2960000:PXLIMDT,1:"")_":"_(DT+.24)_":AEPRSX"
  1.  S DIR("A")="Encounter Date and Time"
  1.  S DIR("?")="Enter the Date and Time of this encounter"
  1.  D ^DIR
  1.  Q $S(+Y>0:+Y,1:-1)
  1.  ;
  1. CODT(PXBEXIT) ;Ask the user the Check out Date/Time
  1.  N PXCHKOUT
  1.  D CHIKOUT^PXBAPI2("",PXBPAT,PXBHLOC,PXBVSTDT)
  1.  S PXBCODT=PXCHKOUT
  1.  S:PXCHKOUT=-1 PXBCODT=""
  1.  ;; PX*1*113 - Change for EAS*1*3 Appointment processing removed
  1.  ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T D  Q:PXBEXIT<1
  1.  ;. S:$G(EASACT)'="W" EASACT="C"
  1.  ;. I $$MT^EASMTCHK(PXBPAT,"",EASACT,PXBVSTDT) D  S PXBEXIT=-1
  1.  ;. . D PAUSE^VALM1
  1.  I WHAT'["ADDEDIT",PXCHKOUT=-1 S PXBEXIT=-1
  1.  I $G(PXBVST),$$DISPOSIT^PXUTL1(DFN,$P($G(^AUPNVSIT(PXBVST,0)),"^",1),PXBVST) S PXBEXIT=1
  1.  Q
  1.  ;
  1. SCC(PXBEXIT) ;Ask the user the Service connected conditions
  1.  N PXBDATA,PXBCLASS,PXBOUTEN
  1.  S PXBOUTEN=""
  1.  ;I $$APPOINT^PXUTL1(PXBPAT,PXBVSTDT,PXBHLOC) D
  1.  ;. S PXBOUTEN=$P($G(^DPT(+PXBPAT,"S",+PXBVSTDT,0)),"^",20)
  1.  ;E  I $$DISPOSIT^PXUTL1(PXBPAT,PXBVSTDT,PXBVST) D
  1.  ;. S PXBOUTEN=+$P($G(^DPT(+PXBPAT,"DIS",9999999-PXBVSTDT,0)),"^",18)
  1.  ;I 'PXBOUTEN,$G(PXBVST)>0 S PXBOUTEN=$O(^SCE("AVSIT",PXBVST,0))
  1.  ;D CLASS^PXBAPI21(PXBOUTEN,PXBPAT,PXBVSTDT,PXBHLOC)
  1.  D CLASS^PXBAPI21(PXBOUTEN,PXBPAT,PXBVSTDT,PXBHLOC,PXBVST)
  1.  ;PX*1*111 - Add HNC
  1.  F PXBCLASS=1:1:6 I $G(PXBDATA("ERR",PXBCLASS))=4 S PXBEXIT=-1 Q  ; changed 6/17/98 for MST enhancement
  1.  Q:PXBEXIT<1
  1.  S PXB800(1)=$P($G(PXBDATA(3)),"^",2)
  1.  S PXB800(2)=$P($G(PXBDATA(1)),"^",2)
  1.  S PXB800(3)=$P($G(PXBDATA(2)),"^",2)
  1.  S PXB800(4)=$P($G(PXBDATA(4)),"^",2)
  1.  S PXB800(5)=$P($G(PXBDATA(5)),"^",2) ;added 6/17/98 for MST enhancement
  1.  ;PX*1*111 - Add HNC
  1.  S PXB800(6)=$P($G(PXBDATA(6)),"^",2)
  1.  Q
  1.  ;
  1. VISIT(PXBEXIT) ;Creat or edit the Visit
  1.  ;Set up ^TMP("PXK",$J and call PXK
  1.  I PXBVST>0 L +^AUPNVSIT(PXBVST):10 E  W !!,$C(7),"Cannot edit at this time, try again later." D WAIT^PXCEHELP S PXBEXIT=-2 Q
  1.  K ^TMP("PXK",$J)
  1.  N PXBNODE,PXBAFTER,PXKERROR
  1.  F PXBNODE=0,21,150,800,811,812 D
  1.  . S PXBAFTER(PXBNODE)=$S(PXBVST>0:$G(^AUPNVSIT(PXBVST,PXBNODE)),1:"")
  1.  . S ^TMP("PXK",$J,"VST",1,PXBNODE,"BEFORE")=PXBAFTER(PXBNODE)
  1.  I PXBVST'>0 D
  1.  . S $P(PXBAFTER(0),"^",1)=PXBVSTDT
  1.  . S $P(PXBAFTER(0),"^",5)=PXBPAT
  1.  . S $P(PXBAFTER(0),"^",8)=$P(^SC(PXBHLOC,0),"^",7)
  1.  . S:PXBAPPT>0 $P(PXBAFTER(0),"^",16)="A"
  1.  . S $P(PXBAFTER(150),"^",3)="P"
  1.  . S $P(PXBAFTER(812),"^",2)=PXBPKG
  1.  . S $P(PXBAFTER(812),"^",3)=PXBSOURC
  1.  S $P(PXBAFTER(0),"^",18)=$G(PXBCODT)
  1.  S:$P(PXBAFTER(0),"^",22)="" $P(PXBAFTER(0),"^",22)=PXBHLOC
  1.  S $P(PXBAFTER(800),"^",1)=$G(PXB800(1))
  1.  S $P(PXBAFTER(800),"^",2)=$G(PXB800(2))
  1.  S $P(PXBAFTER(800),"^",3)=$G(PXB800(3))
  1.  S $P(PXBAFTER(800),"^",4)=$G(PXB800(4))
  1.  S $P(PXBAFTER(800),"^",5)=$G(PXB800(5)) ;added 6/17/98 for MST emhancement
  1.  ;PX*1*111 - Add HNC
  1.  S $P(PXBAFTER(800),"^",6)=$G(PXB800(6))
  1.  I $D(PXELAP)#2 D
  1.  . S $P(PXBAFTER(0),"^",21)=+PXELAP
  1.  F PXBNODE=0,21,150,800,811,812 D
  1.  . S ^TMP("PXK",$J,"VST",1,PXBNODE,"AFTER")=PXBAFTER(PXBNODE)
  1.  S ^TMP("PXK",$J,"VST",1,"IEN")=$S(PXBVST>0:PXBVST,1:"")
  1.  S ^TMP("PXK",$J,"SOR")=PXBSOURC
  1.  D EN1^PXKMAIN
  1.  I PXBVST>0 L -^AUPNVSIT(PXBVST):5
  1.  S PXBVST=$G(^TMP("PXK",$J,"VST",1,"IEN"))
  1.  Q
  1.  ;
  1. CPT(PXBEXIT) ;Ask the user Providers and CTPs
  1.  D CPT^PXBMCPT(PXBVST) K PRVDR
  1.  Q
  1.  ;
  1. POV(PXBEXIT) ;Ask the user Diagnoses
  1.  D POV^PXBMPOV(PXBVST) K PRVDR
  1.  Q
  1.  ;
  1. PRV(PXBEXIT) ;Ask the user Providers
  1.  D PRV^PXBMPRV(PXBVST,"PRV") K PRVDR
  1.  Q
  1.  ;
  1. STP(PXBEXIT) ;Ask the user Stop Codes
  1.  I $L($T(DATE^SCDXUTL)),$$DATE^SCDXUTL(+$G(^AUPNVSIT(PXBVST,0))) Q
  1.  D STP^PXBMSTP(PXBVST) K PRVDR
  1.  Q
  1.  ;