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

IBCU75.m

Go to the documentation of this file. 
  1. IBCU75 ;ALB/JRA - INTERCEPT SCREEN INPUT OF PROCEDURE CODES (ENTER CMN INFO) ;23-Apr-18
  1.  ;;2.0;INTEGRATED BILLING;**608**;21-MAR-94;Build 90
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. CMN(IBXIEN,IBPROCP) ;JRA;IB*2.0*608 Prompt user for CMN info
  1.  ;Input: IBXIEN  = Internal bill/claim number
  1.  ;       IBPROCP = Procedure line subscript in ^DGCR
  1.  ;
  1.  Q:('$G(IBXIEN)!('$G(IBPROCP)))
  1.  N ABGMSG,ABGPO2,CERTDT,CERTYP,CHNGFRM,CMNNODE,CMNREQ,CMSG,DA,DIC,DIE,DIR,DGLB,DR,DRTAG,DTOLD,EDIT,EVNTDT,FIEN,FNAM,FORM,FRMTAG
  1.  N FRMTYP,HT,HTOLD,I,IBPEB,WTOLD,LKGLB,LPM4ABG,LPM4SAT,MSG,NODE0,O2SAT,OK,OLDVAL,PROCA,PROCB,QUIT,RRDT,TDY,THERPYDT,X,Y
  1.  S DGLB="^TMP(""CMN"",$J)" K @DGLB
  1.  S LKGLB="^DGCR(399,"_IBXIEN_")" L +@LKGLB:0 I '$T W !,$C(7),"Another user is editing this entry -- EXITING" H 2 Q
  1.  S EVNTDT=$$FMTE^DILIBF($G(IBDT),"5U")  ;Get the Event Date - will be the default for several date fields.
  1.  S TDY=$$HTFM^DILIBF(+$H)
  1.  S ABGMSG="""ABG PO2"" and/or ""O2 Saturation"" Test(s) REQUIRED"
  1.  S DA=IBPROCP,DA(1)=IBXIEN,DIE="^DGCR(399,"_IBXIEN_",""CP"","
  1.  ;Set FORM array of CMN Data Nodes (D399.6 field 3) indexed by CMN Form Type ien
  1.  S FNAM="" F  S FNAM=$O(^IBE(399.6,"B",FNAM)) Q:FNAM=""  S FIEN=+$O(^IBE(399.6,"B",FNAM,"")) I FIEN D
  1.  . S FORM(FIEN)=$P($G(^IBE(399.6,FIEN,0)),U,4) K:$TR(FORM(FIEN)," ")="" FORM(FIEN)
  1.  I $D(FORM)'>1 S FORM(1)="CMN-484",FORM(2)="CMN-10126"  ;Default nodes for CMN data
  1.  S DIE("NO^")="BACKOUTOK"
  1.  S CMNREQ("MSG")="If ""CMN Required?"" is changed to ""NO"", existing CMN data will be deleted!"
  1.  S FRMTYP("MSG")="Changing the Form Type will delete any data specific to the current Form Type!"
  1.  S CERTYP("MSG")="You are changing the Certification Type!"
  1.  S CERTYP("MSGI")="Changing Certification Type to ""I"" will delete ""Recertification/Revision Date!"""
  1.  D CMNREQ
  1.  S QUIT=0 F  D  Q:QUIT
  1.  . D ^DIE
  1.  . S CMNREQ=$G(CMNREQ),FRMTYP=$G(FRMTYP),CERTYP=$G(CERTYP)
  1.  . S CMNREQ=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,23,"I") I CMNREQ=0 S QUIT=1 Q
  1.  . S FRMTYP=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24,"I")
  1.  . S CERTYP=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.01,"I")
  1.  . I FRMTYP,CERTYP'="" S QUIT=1 Q
  1.  . I CMNREQ="" W $C(7),!,?3,"""CMN Required?"" is a REQUIRED field!" D CMNREQ Q
  1.  . S MSG=""
  1.  . I FRMTYP="" S MSG="""Form Type"" and ""Certification Type"" are REQUIRED!",DRTAG="CMNREQ"
  1.  . E  I CERTYP="" S MSG="""Certification Type"" is REQUIRED!",DRTAG="CMNREQ"
  1.  . I MSG]"" S DR="",MSG=MSG_$C(13,10)_"   ** To exit, set ""CMN Required?"" to ""NO""" W $C(7),!,?3,MSG D @DRTAG Q
  1.  . S QUIT=1
  1.  ;
  1.  ;If CMN is not required, delete all CMN data that may be associated with this procedure & exit
  1.  I $G(CMNREQ)=0 D  Q
  1.  . S FIEN="" F  S FIEN=$O(FORM(FIEN)) Q:FIEN=""  I FORM(FIEN)]"" D
  1.  . . S CMNNODE="^DGCR(399,"_IBXIEN_",""CP"","_IBPROCP_","""_FORM(FIEN)_""")" K @CMNNODE
  1.  . S CMNNODE="^DGCR(399,"_IBXIEN_",""CP"","_IBPROCP_",""CMN"")" K @CMNNODE S @CMNNODE=0
  1.  ;
  1.  ;If user selected Form Type we need to remove data that may exist for any other Form Type.
  1.  I $G(FRMTYP) S FIEN="" F  S FIEN=$O(FORM(FIEN)) Q:FIEN=""  I FIEN'=FRMTYP D
  1.  . S CMNNODE="^DGCR(399,"_IBXIEN_",""CP"","_IBPROCP_","""_FORM(FIEN)_""")" K @CMNNODE
  1.  ;
  1.  I $G(CERTYP)="I" D SETFLD(24.07,"@")  ;If "Certification Type" is "INITIAL" delete "Recertification/Revision Date"
  1.  ;
  1.  I (($D(EDIT)&($G(EDIT)'="Y"))!(X=""!('$G(CMNREQ)!('$G(FRMTYP)!($G(CERTYP)=""))))) Q
  1.  ;
  1.  S FRMTAG="DR"_$S($G(FORM(FRMTYP))[484:484,1:10126)  ;Set tag to call to set DR with form-specific logic
  1.  D DRCOMM
  1.  ;
  1.  ;Prompt user for remaining questions & check for missing required fields
  1.  S (QUIT,UPCT)=0,DRTAG(1)="" F  D  Q:QUIT
  1.  . D ^DIE
  1.  . K MSG S MSG=0
  1.  . S DRTAG=""
  1.  . S CERTYP=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.01,"I")
  1.  . S HT=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.02,"I")
  1.  . S THERPYDT=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.05,"I")
  1.  . S CERTDT=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.06,"I")
  1.  . S RRDT=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.07,"I")
  1.  . I 'CERTDT S MSG=MSG+1,MSG(MSG)="""Last Certification Date""" S DRTAG="DRCOMM"
  1.  . I 'RRDT,CERTYP'="I" S MSG=MSG+1,MSG(MSG)="""Recertification/Revision Date""" S:DRTAG="" DRTAG="RRDT"
  1.  . I 'THERPYDT S MSG=MSG+1,MSG(MSG)="""Date Therapy Started""" S:DRTAG="" DRTAG="STRTDT"
  1.  . I FORM(FRMTYP)[10126 D
  1.  . . I $$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.217,"I")="" S MSG=MSG+1,MSG(MSG)="""Is this for Parenteral nutrition, Enteral nutrition, or Both?""" S:DRTAG="" DRTAG="DR10126"
  1.  . I +MSG D  Q
  1.  . . S:X="" UPCT=UPCT+1 I UPCT>1,DRTAG=DRTAG(1) S QUIT=1 Q
  1.  . . S DR="" W $C(7) F I=1:1:MSG W !,?3,MSG(I)_" is REQUIRED!"
  1.  . . W !,?3,"** Exiting now will leave required fields unanswered."
  1.  . . W !,?3,"** If you must exit, enter '^' again."
  1.  . . S DRTAG(1)=DRTAG D @DRTAG
  1.  . S QUIT=1
  1.  ;
  1.  ;Delete dates associated with result fields that were deleted
  1.  I $D(@DGLB)>1 D
  1.  . N FLD
  1.  . S FLD="" F  S FLD=$O(@DGLB@(FLD)) Q:FLD=""  D SETFLD(FLD,"@")
  1.  . K @DGLB
  1.  Q
  1.  ;
  1. CMNREQ ; Set DR with logic for 1st 3 fields: "CMN Required?", "Form Type" and "Certification Type"
  1.  S DR="@23;S CMNREQ(""OLD"")=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,23,""I"");23R~T//NO;S CMNREQ=X I 'X,'CMNREQ(""OLD"") S Y=""@999"";"
  1.  S DR=DR_"I CMNREQ=0,CMNREQ(""OLD"")=1 S FRM=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24,""I"") S:'FRM OK=1 S:FRM OK=$$USEROK^IBCU75(23,1,CMNREQ(""MSG""))"
  1.  S DR=DR_" S:OK Y=""@999"" I 'OK S Y=""@23"";"
  1. FRMTYP ;Entry point to set DR with logic for "Form Type" and "Certification Type" fields in preparation for re-prompting.
  1.  S DR=DR_"@24;S DIC(0)=""N"" S FRMTYP(""OLD"")=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24,""I"");24R~T;S FRMTYP=X I FRMTYP(""OLD"")]"""",FRMTYP]"""""
  1.  S DR=DR_",FRMTYP'=FRMTYP(""OLD"") S OK=$$USEROK^IBCU75(24,FRMTYP(""OLD""),FRMTYP(""MSG"")) S:OK CHNGFRM=1 S:'OK Y=""@24"";"
  1.  S DR=DR_"I $G(CHNGFRM)!($$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.01,""I"")="""") D COPYCMN^IBCU75(IBXIEN,IBPROCP,FRMTYP);"
  1.  S DR=DR_"I $$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.01,""I"")]"""",'$G(CHNGFRM) R !,""Edit CMN Information for this Procedure? NO// "",EDIT S EDIT=$E($ZCONVERT(EDIT,""U"")) "
  1.  S DR=DR_"W:(EDIT]""""&(EDIT'=""^"")) ""  ""_$S(EDIT=""Y"":""YES"",1:""NO"") I EDIT'=""Y"" S Y=""@999"";"
  1. CERTYP ;Entry point to set DR with logic for "Certification Type" field in preparation for re-prompting.
  1.  S DR=DR_"@01;S CERTYP(""OLD"")=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.01,""I"");24.01R~T//INITIAL"
  1.  S DR=DR_";S CERTYP=X I CERTYP(""OLD"")]"""",CERTYP]"""",CERTYP'=CERTYP(""OLD"")"
  1.  S DR=DR_" S CMSG=$S(CERTYP=""I"":CERTYP(""MSGI""),1:CERTYP(""MSG""))"
  1.  S DR=DR_" S OK=$$USEROK^IBCU75(24.01,CERTYP(""OLD""),CMSG) S:'OK Y=""@01"";@999;"
  1.  Q
  1.  ;
  1. DRCOMM ;Set DR with logic for the remaining fields common to all form types
  1.  S DR="@06;S DTOLD=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.06,""I"");24.06R~T//"_EVNTDT_";D DTCHK^IBCU75(X,TDY,""06"",$G(DTOLD));"
  1.  S DR=DR_"I CERTYP=""I"" S @DGLB@(24.07)="""",Y=""@02"";"
  1. RRDT ;Entry point to set DR with logic for "Recertification/Revision Date"... fields in preparation for re-prompting.
  1.  S DR=DR_"@07;S DTOLD=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.07,""I"");24.07R~T//"_EVNTDT_";D DTCHK^IBCU75(X,TDY,""07"",$G(DTOLD));"
  1.  S DR=DR_"@02;S HTOLD=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.02,""I"");24.02T;I X>96 S OK=$$USEROK^IBCU75(24.02,HTOLD,""Patient is over 8 feet tall!"")"
  1.  S DR=DR_" I 'OK S Y=""@02"";@03;S WTOLD=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.03,""I"");24.03T;I X>500 S OK=$$USEROK^IBCU75(24.03,WTOLD,"
  1.  S DR=DR_"""Patient is over 500 pounds!"") I 'OK S Y=""@03"";24.04T;"
  1. STRTDT ;Entry point to set DR with logic for "Date Therapy Started"... fields in preparation for re-prompting.
  1.  S DR=DR_"@05;S DTOLD=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.05,""I"");24.05R~T//"_EVNTDT_";D DTCHK^IBCU75(X,TDY,""05"",$G(DTOLD));@08;24.08T//N;"
  1.  D @FRMTAG
  1.  Q
  1.  ;
  1. DR484 ;Set DR with logic specific for form CMN-484
  1.  S DR=DR_"@100;24.1T;S ABGPO2=X;@102;24.102T;S O2SAT=X;I ABGPO2="""",O2SAT="""" S Y=""@104"";"
  1.  S DR=DR_"@103;S DTOLD=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.103,""I"");24.103T;D DTCHK^IBCU75(X,TDY,103,$G(DTOLD));"
  1.  S DR=DR_"@104;I (ABGPO2<56!(ABGPO2>59)),(O2SAT'=89) S @DGLB@(24.104)="""",@DGLB@(24.105)="""""
  1.  S DR=DR_",@DGLB@(24.106)="""",Y=""@107"";24.104T//NO;24.105T//NO;24.106T//NO;@107;24.107T;24.108T;24.109T;24.11T;I X'>4 S @DGLB@(24.111)="""""
  1.  S DR=DR_",@DGLB@(24.113)="""",@DGLB@(24.114)="""",Y=""@115"";24.111T;S ABG4LPM=X;"
  1.  S DR=DR_"@113;24.113T;I 'ABG4LPM,'X S Y=""@115"",@DGLB@(24.114)="""";"
  1.  S DR=DR_"@114;S DTOLD=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.114,""I"");24.114T;D DTCHK^IBCU75(X,TDY,114,$G(DTOLD));@115;24.115T;@999;"
  1.  Q
  1.  ;
  1. DR10126 ;Set DR with logic specific to the CMN-10126
  1.  S DR=DR_"@217;S IBPEB(""OLD"")=$$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.217,""I"");24.217R~T//P;S IBPEB=X I IBPEB(""OLD"")]"""",IBPEB]"""",IBPEB(""OLD"")'=IBPEB "
  1.  S DR=DR_"S OK=$$USEROK^IBCU75(24.217,IBPEB(""OLD""),""You are changing the nutrition type!"") S:'OK Y=""@217"";I $G(IBPEB)=""P"" S Y=""@206"" "
  1.  S DR=DR_"N I F I=24.201:.001:24.205,24.218,24.219 S @DGLB@(I)="""";24.201T;24.202T;"
  1.  S DR=DR_"24.204T;I '+X S Y=""@205"",@DGLB@(24.203)="""" I $$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.219)]"""" S Y=""@219"";"
  1.  S DR=DR_"24.203T;I '+X S Y=""@205"" I $$CMNDATA^IBCEF31(IBXIEN,IBPROCP,24.219)]"""" S Y=""@219"";"
  1.  S DR=DR_"@219;24.219T;I '+X S Y=""@205"",@DGLB@(24.218)="""";"
  1.  S DR=DR_"24.218T;@205;24.205T;@206;24.206T;I $G(IBPEB)=""E"" S Y=""@999"" "
  1.  S DR=DR_"N I F I=24.207:.001:24.216 S @DGLB@(I)="""";"
  1.  S DR=DR_"24.207T;24.208T;24.209T;24.21T;24.211T;24.212T;24.213T;24.215T;24.216T;@214;24.214T;@999;"
  1.  Q
  1.  ;
  1. COPYCMN(IBXIEN,IBPROCP,FRMTYP) ;Copy CMN information from last procedure entered that has it to current procedure
  1.  ;Input: IBXIEN  = Internal bill/claim number
  1.  ;       IBPROCP = Procedure line subscript
  1.  ;       FRMTYP  = CMN Form Type ien
  1.  ;
  1.  N DONE
  1.  S DONE=0
  1.  Q:('$G(IBXIEN)!('$G(IBPROCP)!('$G(FRMTYP))))
  1.  N FRMND,FRMNDI,IBPROC,IBXSAVE,Z
  1.  S FRMNDI=FORM(FRMTYP)
  1.  D CMNDEX^IBCEF31(IBXIEN,.IBXSAVE)
  1.  S Z="" F  S Z=$O(IBXSAVE("CMNDEX",Z),-1) Q:'Z  S IBPROC=+IBXSAVE("CMNDEX",Z) I IBPROCP,IBPROC'=IBPROCP D  Q:DONE
  1.  . Q:('$D(^DGCR(399,IBXIEN,"CP",IBPROC,"CMN"))!('$D(^DGCR(399,IBXIEN,"CP",IBPROC,FRMNDI))))
  1.  . S FRMND=$O(^DGCR(399,IBXIEN,"CP",IBPROC,"CMN")) Q:(FRMND=""!(FRMND'=FRMNDI))
  1.  . S ^DGCR(399,IBXIEN,"CP",IBPROCP,"CMN")=^DGCR(399,IBXIEN,"CP",IBPROC,"CMN")
  1.  . S ^DGCR(399,IBXIEN,"CP",IBPROCP,FRMND)=^DGCR(399,IBXIEN,"CP",IBPROC,FRMND)
  1.  . S DONE=1
  1.  Q 
  1.  ;
  1. USEROK(FLD,OLDVAL,MSG) ;JRA;IB*2.0*608 Prompt user if OK to change field value
  1.  ;Input: FLD    =  Field for which we are asking the user to confirm the change
  1.  ;       OLDVAL =  Value of the field before user changed
  1.  ;       MSG    =  Warning message to display to user regarding the implications of the change
  1.  ;
  1.  Q:'$G(FLD) 0
  1.  N DIC,DIR,X,Y
  1.  S OLDVAL=$G(OLDVAL)
  1.  W $C(7) I $TR($G(MSG)," ")]"" W !,MSG
  1.  S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="NO" D ^DIR
  1.  I Y'=1 D SETFLD(FLD,OLDVAL)  ;Set field back to old value if user doesn't want to continue
  1.  I Y=1 S X="^"
  1.  Q Y
  1.  ;
  1. SETFLD(FLD,VAL) ;JRA;IB*2.0*608 Set/Delete field data w/out user prompting
  1.  ;Input: FLD = Field to set/delete
  1.  ;       VAL = Value to set FLD to (Note: '@' will delete field value)
  1.  ;
  1.  Q:('$G(FLD)!($G(VAL)=""))
  1.  N DIE,DI,DL,DP,DQ,DR,X,Y
  1.  S DIE="^DGCR(399,"_IBXIEN_",""CP"","
  1.  S DR=FLD_"////"_VAL
  1.  D ^DIE
  1.  Q
  1.  ;
  1. DTCHK(X,TDY,TAG,DTOLD) ;JRA;IB*2.0*608 Check if future date entered by user
  1.  ;Input:  X     = User entry for date field (internal FileMan date format)
  1.  ;        TDY   = Today's internal FileMan date
  1.  ;        TAG   = Field tag to jump to if user enters a future date (usually re-prompt same date)
  1.  ;        DTOLD = The value of the date field prior to user edit
  1.  ;
  1.  Q:('$G(X))!('$G(TAG))
  1.  N FLD
  1.  S:$G(DTOLD)="" DTOLD="@"
  1.  S:'$G(TDY) TDY=$$HTFM^DILIBF(+$H) Q:X'>TDY
  1.  ;User entered future date so display error and change date back to previous value.
  1.  W $C(7),!,?3,"Future dates not allowed??"
  1.  S Y="@"_TAG
  1.  D SETFLD("24."_TAG,DTOLD)  ;set back to prior date
  1.  Q
  1.  ;