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

ACHSPAP1.m

Go to the documentation of this file. 
  1. ACHSPAP1 ; IHS/ITSC/PMF - LINK TO PATIENT CARE COMPONENT (2/2) ; [ 12/06/2002  10:36 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Clarify PCC link messages.
  1.  Q
  1.  ;
  1. CHS ;EP - Create V CHS data
  1.  ;
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.03 (ADD)]"
  1.  ;
  1.  ; .01 - Authorizing Facility
  1.  S APCDALVR("APCDTFAC")="`"_DUZ(2)
  1.  ;
  1.  ; .02 - Patient Name
  1.  S APCDALVR("APCDPAT")="`"_$P(ACHSDOCR,U,22)
  1.  ;
  1.  ; .04 - Authorization Number
  1.  S ACHSX=$P(ACHSDOCR,U,14)
  1.  D FYCVT^ACHSFU
  1.  S (X,APCDALVR("APCDTAUT"))=$E(ACHSY,3,4)_ACHSFC_$P(ACHSDOCR,U)
  1.  X $P(^DD(9000010.03,.04,0),U,5,99)
  1.  I '$D(X) S APCDALVR("APCDAFLG")=26_U_APCDALVR("APCDTAUT") Q
  1.  ;
  1.  ; .05 - Pay status
  1.  S (X,APCDALVR("APCDTPAY"))=$P(ACHSTRAN,U,5)
  1.  X $P(^DD(9000010.03,.05,0),U,5,99)
  1.  I "FP"'[APCDALVR("APCDTPAY") S APCDALVR("APCDAFLG")=27_U_APCDALVR("APCDTPAY") Q
  1.  ;
  1.  ; .06 - Total Charges
  1.  I $G(^ACHSF(DUZ(2),"D",ACHSDIEN,"ZA")) S X=$P(^("ZA"),U,1)
  1.  E  S X=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA")),U,1)
  1.  S (X,APCDALVR("APCDTTC"))=$FN(X,"",2)
  1.  X $P(^DD(9000010.03,.06,0),U,5,99)
  1.  I '$D(X) S APCDALVR("APCDAFLG")=28_U_APCDALVR("APCDTTC") Q
  1.  ;
  1.  ; .07 - Date of Discharge
  1.  S X=$$DOC^ACHS(8,3)
  1.  I 'X S X=$P(ACHSTRAN,U,10) I 'X S X=$$DOC^ACHS(3,9) I 'X S X=$$DOC^ACHS(3,1) I 'X S X=$P(ACHSDOCR,U,2)
  1.  S APCDALVR("APCDTDD")=X
  1.  X $P(^DD(9000010.03,.07,0),U,5,99)
  1.  I '$D(X) S APCDALVR("APCDAFLG")=29_U_APCDALVR("APCDTDD") Q
  1.  ;
  1.  ; .08 - Discharge Type
  1.  ; This is a pointer.  Must be converted to value.
  1.  S APCDALVR("APCDTDT")=1,X=$$DOC^ACHS(8,4)
  1.  I X S X=$G(^DIC(42.2,X,9999999)),APCDALVR("APCDTDT")=$S(X=0:5,X=1:1,X=2:5,X=3:2,X=4:3,X=5:3,X=6:4,X=7:4,1:1)
  1.  ;
  1.  ; .09 - Newborn DX
  1.  ; S APCDALVR("APCDTND")=""
  1.  ;
  1.  ; .11 - Stillborn
  1.  ; S APCDALVR("APCDTSB")=""
  1.  ;
  1.  ; .12 - No of Visits
  1.  S (X,APCDALVR("APCDTNV"))=$P(ACHSTRAN,U,9)
  1.  I 'X S APCDALVR("APCDAFLG")=30_U_X Q
  1.  X $P(^DD(9000010.03,.12,0),U,5,99)
  1.  ; GTH 04-23-97  The V CHS dd only goes up to 999, and it's not clear 
  1.  ; if such a high workload is meaningful to PCC.  See line below.
  1.  I '$D(X) D  S:$D(X) APCDALVR("APCDTNV")=X
  1.  . F X=9999999,999999,99999,9999,999,99 X $P(^DD(9000010.03,.12,0),U,5,99) Q:$D(X)
  1.  .Q
  1.  I '$D(X) S APCDALVR("APCDAFLG")=30_U_APCDALVR("APCDTNV") Q
  1.  ;
  1.  ;
  1.  ; .13 - Hospital Voucher No.
  1.  ; S APCDALVR("APCDTHV")=""
  1.  ;
  1.  ; .14 - Vendor
  1.  S APCDALVR("APCDTVDR")="`"_$P(ACHSDOCR,U,8)
  1.  ;
  1.  D EN^APCDALVR
  1.  ;
  1.  I $D(APCDALVR("APCDAFLG")) S APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"Failed ADD to V CHS." Q
  1.  ;
  1.  I '$$DIE^ACHS("61////"_APCDALVR("APCDADFN")),ACHSWOK W !,"Edit V CHS field of DOCUMENT failed."
  1.  Q
  1.  ;
  1.  ;
  1. VDEN ;EP  Create/update V DENTAL data.
  1.  ; note : Currently no known way to convert CHS info of CPT,
  1.  ;        TOOTH NUMBER and TOOTH SURFACE to ADA code.
  1.  ;
  1.  F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG"))  S ACHS("DEN")=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHS,0)) I $P($P(ACHS("DEN"),U),";",2)="AUTTADA(" D VDEN1
  1.  K ACHS("DEN")
  1.  Q
  1.  ;
  1. VDEN1 ;
  1.  S (DIE,DIC)="^AUTTADA(",DIC(0)=""
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.05 (ADD)]"
  1.  ;
  1.  ; .01 - ADA Service code - APCDTSC
  1.  S (X,APCDALVR("APCDTSC"))="`"_+ACHS("DEN")
  1.  X $P(^DD(9000010.05,.01,0),U,5,99)
  1.  I '$D(X) S APCDALVR("APCDAFLG")=31_U_APCDALVR("APCDTSC") Q
  1.  ;
  1.  ; .02 - Patient Name - APCDPAT
  1.  S APCDALVR("APCDPAT")="`"_$P(ACHSDOCR,U,22)
  1.  ;
  1.  ; .04 - Number of units - APCDTNOU
  1.  S (X,APCDALVR("APCDTNOU"))=$P(ACHS("DEN"),U,4)
  1.  X $P(^DD(9000010.05,.04,0),U,5,99)
  1.  I '$D(X) S APCDALVR("APCDAFLG")=33_U_APCDALVR("APCDTNOU") Q
  1.  ;
  1.  ; .05 - Operative site - APCDTOS
  1.  ; S APCDALVR("APCDTOS")=""
  1.  ;
  1.  ; .06 - Tooth Surface - APCDTSUR
  1.  S APCDALVR("APCDTSUR")=$P(ACHS("DEN"),U,9)
  1.  X $P(^DD(9000010.05,.06,0),U,5,99)
  1.  I '$D(X) S APCDALVR("APCDAFLG")=34_U_APCDALVR("APCDTSUR") Q
  1.  ;
  1.  D EN^APCDALVR
  1.  ;
  1.  I $D(APCDALVR("APCDAFLG")) S APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"Add to V DENTAL failed." Q
  1.  ;
  1.  Q
  1.  ;
  1. VCPT ;EP
  1.  ;GO THRU 'CPT OR REV INFORMATION' MULTIPLE
  1.  ;GET THE 'CPT/REV CODE' THEN GLOBAL FROM WHERE THE CODE COMES FROM
  1.  ;IF = ICPT THEN CONTINUE
  1.  F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG"))  S ACHS("CPT")=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHS,0)) I $P($P(ACHS("CPT"),U),";",2)="ICPT(" D VCPT1
  1.  K ACHS("CPT")
  1.  Q
  1. VCPT1 ;
  1.  S (DIE,DIC)="^ICPT(",DIC(0)=""
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.18 (ADD)]"
  1.  ;
  1.  ; .01 - CPT Code - APCDTCPT
  1.  S (X,APCDALVR("APCDTCPT"))="`"_+ACHS("CPT")
  1.  X $P(^DD(9000010.18,.01,0),U,5,99)      ;IF NOT AN INACTIVE FLAG THEN
  1.  ;                                        X CONTAINS THE RESULT OF THE 
  1.  ;                                        LOOKUP
  1.  ;IF IT CAN'T FIND IT QUIT
  1.  I '$D(X) S APCDALVR("APCDAFLG")=32_U_APCDALVR("APCDTCPT") Q
  1.  ;
  1.  ; .02 - Patient Name - APCDPAT
  1.  S APCDALVR("APCDPAT")="`"_$P(ACHSDOCR,U,22)
  1.  ;
  1.  ; .04 - Provider Narrative - APCDTPN
  1.  ; .05 - Diagnosis - APCDTDX
  1.  ; .07 - Principal Procedure - APCDTPP
  1.  ; .16 - Quanty - APCDTUN
  1.  ; 1201 - Event Date and Time - APCDTCDT
  1.  ; 1202 - Ordering Provider - APCDTPRV
  1.  ; 1203 - Clinic - APCDTCLN
  1.  ; 1204 - Encounter Provider - APCDTEPR
  1.  ; 1208 - Parent - APCDTPNT
  1.  ; 1209 - External Key - APCDTEXK
  1.  ; 1210 - Outside Provider Name - APCDTOPR
  1.  ;         
  1.  D EN^APCDALVR
  1.  ;
  1.  I $D(APCDALVR("APCDAFLG")) S APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"Add to V CPT failed." Q
  1.  ;
  1.  Q
  1.  ;
  1.  N DA,DIC,DR
  1.  ;I $P($G(^AUTTSITE(1,0)),U,8)'="Y" Q 0;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  I $P($G(^AUTTSITE(1,0)),U,8)'="Y" Q "0^PCC is not installed."  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  S DIC="^APCCCTRL("_DUZ(2)_",11,",DIC(0)="",X="CONTRACT HEALTH MGMT SYSTEM"
  1.  D ^DIC
  1.  K DIC
  1.  ;Q:Y<1 0;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  Q:Y<1 "0^CHS not found in PCC MASTER CONTROL file."  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  S DA=+Y,DA(1)=DUZ(2)
  1.  ;Q:$$VAL^XBDIQ1(9001000.011,.DA,.02)'="YES" 0;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  Q:$$VAL^XBDIQ1(9001000.011,.DA,.02)'="YES" "0^Link not 'YES' to CHS in PCC MASTER CONTROL file."  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  S Y=$$VAL^XBDIQ1(9001000.011,.DA,.03)
  1.  I $L(Y) S APCDALVR("APCDTYPE")=$E(Y)
  1.  Q 1
  1.  ;