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

BJPNAPI1.m

Go to the documentation of this file. 
  1. BJPNAPI1 ;GDIT/HS/BEE-Prenatal Care Module API Calls (Cont.) ; 08 May 2012  12:00 PM
  1.  ;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
  1.  ;
  1.  Q
  1.  ;
  1. VFADD(TARGET,PIPIEN,VIEN,APCDALVR) ;PEP - Add entry to the V OB file and update the PIP entry
  1.  ;
  1.  ;This API adds a new entry to the V OB (#9000010.43) file and also adds (or updates)
  1.  ;the corresponding prenatal problem list (#90680.01) entry with the new information.
  1.  ;The V OB file is a dynamic file, meaning it tracks the values of problems over time. Therefore,
  1.  ;a NEW entry to this file is created WHENEVER a problem is added to a patient's PIP OR WHENEVER
  1.  ;an UPDATE is made to that problem entry on the PIP. If an update and fields are not passed in,
  1.  ;current values are used in the new entry.
  1.  ;
  1.  ;The only exception is that notes are stored across entries (to save space in resaving them each time).
  1.  ;To see therefore ALL notes that have been entered for a problem on the PIP, you have to loop through
  1.  ;ALL V OB entries relating to that patient's PIP problem and pull ALL of the notes in each.
  1.  ;
  1.  ;Input:
  1.  ;   PIPIEN - Pointer to prenatal problem list (#90680.01) entry - Null if NEW entry
  1.  ;     VIEN - Visit IEN
  1.  ; APCDALVR - Array of entry values
  1.  ;          - ("APCDSMD")  - Pointer to BJPN SNOMED TERMS (#90680.02) entry. *REQUIRED for NEW PIP entry
  1.  ;          - ("APCDPRI")  - Priority (L-Low,M-Medium,H-High)
  1.  ;          - ("APCDSCO")  - Scope (A-All Pregnancies,C-Current Pregnancy)
  1.  ;          - ("APCDSTS")  - Status (A-Active,I-Inactive)
  1.  ;          - ("APCDEDD")  - Definitive EDD - Internal FM format
  1.  ;          - ("APCDPTX")  - Provider Text String
  1.  ;          - ("APCDPOV")  - Visit Set as POV (1-Yes,""-No)
  1.  ;          - ("NOTE")     - Note to be added
  1.  ;          - ("APCDDELD") - Problem Deleted Date/Time - Internal FM format
  1.  ;          - ("APCDDELB") - Problem Deleted By - DUZ value
  1.  ;          - ("APCDDELR") - Problem Delete Reason - (D-Duplicate,E-Entered in Error,O-Other)
  1.  ;          - ("APCDDELO") - Delete Reason - if other
  1.  ;
  1.  ;Output:
  1.  ;  TARGET - Piece 1 - 1-Success/0-Failure
  1.  ;           Piece 2 - PIPIEN
  1.  ;           Piece 3 - Error Message
  1.  ;
  1.  NEW DFN,ADD,SMDTM,NOW,%,APCDVUPD,BJPNUPD,ERROR,IEN,EVDT,PPROV,PKIEN,APCDTMP
  1.  ;
  1.  ;Save current copy of APCDALVR
  1.  M APCDTMP=APCDALVR
  1.  ;
  1.  ;Input validation
  1.  S PIPIEN=$G(PIPIEN)
  1.  S PKIEN=$G(APCDALVR("APCDSMD"))
  1.  I PIPIEN="",PKIEN="" S @TARGET@(1,0)="0^^New PIP problem - Missing APCDPKL" G XVFADD
  1.  I $G(VIEN)="" S @TARGET@(1,0)="0^^Missing VIEN" G XVFADD
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I") I DFN="" S @TARGET@(1,0)="0^^Missing DFN" G XVFADD
  1.  ;
  1.  D NOW^%DTC S NOW=%
  1.  ;
  1.  ;Set up additional APCDALVR entries
  1.  S APCDALVR("APCDPAT")=DFN
  1.  S APCDALVR("APCDVSIT")=VIEN
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.43 (MOD)]"
  1.  S APCDALVR("APCDAUTO")=1
  1.  S APCDALVR("AUPNTALK")=""
  1.  S APCDALVR("APCDLMD")=NOW
  1.  S:$D(APCDALVR("NOTE")) APCDVUPD(2100)=1
  1.  S APCDALVR("APCDEPV")=DUZ
  1.  ;
  1.  ;Determine if Add or Update - Look for UPDATE match if PIPIEN isn't passed
  1.  S ADD=0 S:PIPIEN="" ADD=1
  1.  I ADD=1 S IEN="" F  S IEN=$O(^BJPNPL("AC",DFN,PKIEN,IEN)) Q:IEN=""  D  Q:'ADD
  1.  . ;
  1.  . ;Skip Deletes
  1.  . I $$GET1^DIQ(90680.01,IEN_",",2.01,"I")]""
  1.  . S ADD=0,PIPIEN=IEN
  1.  ;
  1.  ;If update, make sure it hasn't been deleted
  1.  I ADD=0,$$GET1^DIQ(90680.01,PIPIEN_",",2.01,"I")]"" S @TARGET@(1,0)="0^^Problem has been deleted - enter a new record (send PIPIEN as null)" G XVFADD
  1.  ;
  1.  ;Define Technical Note
  1.  I ADD=1 S APCDALVR("TNOTE")="Added Problem To PIP"
  1.  E  S APCDALVR("TNOTE")="Updated Problem Entry"
  1.  ;
  1.  ;If Add - Create 90680.01 entry
  1.  I ADD=1 D  I PIPIEN="" G XVFADD
  1.  . NEW DIC,DLAYGO,X,Y
  1.  . S DIC="^BJPNPL("
  1.  . S DLAYGO=90680.01,DIC("P")=DLAYGO,DIC(0)="LOX"
  1.  . S X=PKIEN
  1.  . S DIC("DR")=".02////"_DFN_";.03////"_PKIEN
  1.  . K DO,DD D FILE^DICN
  1.  . I Y=-1 S @TARGET@(1,0)="0^^Could not add problem to PIP" Q
  1.  . S PIPIEN=+Y
  1.  S APCDALVR("APCDPIP")=PIPIEN
  1.  ;
  1.  ;Get SNOMED Term
  1.  S SMDTM=$$GET1^DIQ(90680.02,PKIEN_",",.02,"E")
  1.  ;
  1.  ;Priority
  1.  I $D(APCDALVR("APCDPRI")) S APCDVUPD(.06)=""
  1.  I $D(APCDALVR("APCDPRI")),APCDALVR("APCDPRI")="" S APCDALVR("APCDPRI")="@"
  1.  I ADD=0,'$D(APCDALVR("APCDPRI")) S APCDALVR("APCDPRI")=$$GET1^DIQ(90680.01,PIPIEN_",",.06,"I")
  1.  ;
  1.  ;Provider Text
  1.  S:$G(APCDALVR("APCDPTX"))]"" APCDALVR("APCDPTX")=$$PNARR^BJPNVFIL(APCDALVR("APCDPTX")),APCDVUPD(.07)=""
  1.  I ADD=0,'$D(APCDALVR("APCDPTX")) S APCDALVR("APCDPTX")=$$GET1^DIQ(90680.01,PIPIEN_",",.05,"I")
  1.  ;
  1.  ;Provider Narrative
  1.  I $G(APCDALVR("APCDPTX"))]"" D
  1.  . NEW PTX
  1.  . S PTX=$$GET1^DIQ(9999999.27,APCDALVR("APCDPTX"),".01","E")
  1.  . S APCDALVR("APCDPNR")=$E(SMDTM_"| "_PTX,1,160)
  1.  . S APCDALVR("APCDPNR")=$$PNARR^BJPNVFIL(APCDALVR("APCDPNR"))
  1.  . S APCDVUPD(.11)=""
  1.  ;
  1.  ;Scope
  1.  I (ADD=1)!$D(APCDALVR("APCDSCO")) S APCDVUPD(.08)=""
  1.  I ADD=0,'$D(APCDALVR("APCDSCO")) S APCDALVR("APCDSCO")=$$GET1^DIQ(90680.01,PIPIEN_",",.07,"I")
  1.  I ADD=1,'$D(APCDALVR("APCDSCO")) S APCDALVR("APCDSCO")="C"
  1.  ;
  1.  ;Status
  1.  I (ADD=1)!$D(APCDALVR("APCDSTS")) S APCDVUPD(.09)=""
  1.  I ADD=0,'$D(APCDALVR("APCDSTS")) S APCDALVR("APCDSTS")=$$GET1^DIQ(90680.01,PIPIEN_",",.08,"I")
  1.  I ADD=1,'$D(APCDALVR("APCDSTS")) S APCDALVR("APCDSTS")="A"
  1.  ;
  1.  ;Definitive EDD
  1.  I (ADD=1)!$D(APCDALVR("APCDEDD")) S APCDVUPD(.1)=""
  1.  I ADD=0,'$D(APCDALVR("APCDEDD")) S APCDALVR("APCDEDD")=$$GET1^DIQ(90680.01,PIPIEN_",",.09,"I")
  1.  I ADD=1,'$D(APCDALVR("APCDEDD")) S APCDALVR("APCDEDD")=$$GET1^DIQ(9000017,DFN_",",1311,"I")
  1.  ;
  1.  ;Snomed Term
  1.  I (ADD=1)!$D(APCDALVR("APCDSMD")) S APCDVUPD(.12)=""
  1.  I ADD=0,'$D(APCDALVR("APCDSMD")) S APCDALVR("APCDSMD")=$$GET1^DIQ(90680.01,PIPIEN_",",.01,"I")
  1.  ;
  1.  ;Process Deletes
  1.  I $D(APCDALVR("APCDDELB")) S APCDVUPD(2.01)=""
  1.  I $D(APCDALVR("APCDDELD")) S APCDVUPD(2.02)=""
  1.  I $D(APCDALVR("APCDDELR")) S APCDVUPD(2.03)=""
  1.  I $D(APCDALVR("APCDDELO")) S APCDVUPD(2.04)=""
  1.  ;
  1.  ;Set as POV
  1.  I $D(APCDALVR("APCDPOV")) D
  1.  . S APCDVUPD(.05)=""
  1.  . I APCDALVR("APCDPOV")=1 Q
  1.  . I APCDALVR("APCDPOV")="" S APCDALVR("APCDPOV")="@"
  1.  ;
  1.  ;Original Entry Date/Entered By
  1.  I ADD=1 S APCDALVR("APCDOEDT")=NOW,APCDALVR("APCDOEBY")=DUZ,APCDVUPD(1216)="",APCDVUPD(1217)=""
  1.  E  D
  1.  . S APCDALVR("APCDOEDT")=$$GET1^DIQ(90680.01,PIPIEN_",",1.01,"I")
  1.  . S APCDALVR("APCDOEBY")=$$GET1^DIQ(90680.01,PIPIEN_",",1.02,"I")
  1.  ;
  1.  ;Last Modified Date and By
  1.  S APCDALVR("APCDLMDT")=NOW
  1.  S APCDALVR("APCDLMBY")=DUZ
  1.  ;
  1.  ;1201 EVENT DATE AND TIME
  1.  S EVDT=$$GET1^DIQ(9000010,VIEN_",",.01,"I")
  1.  I EVDT]"" S APCDALVR("APCDEDT")=EVDT
  1.  ;
  1.  ;Ordering Provider
  1.  ;S PPROV=$$PPRV^BJPNPKL(VIEN)
  1.  ;I PPROV]"" S APCDALVR("APCDOPV")=PPROV
  1.  ;
  1.  ;Save Technical Notes
  1.  S APCDVUPD(1218)="",APCDVUPD(1219)=""
  1.  M APCDALVR("TNOTE")=APCDVUPD
  1.  ;
  1.  ;File V OB entry
  1.  D ^APCDALVR
  1.  I $G(APCDALVR("APCDAFLG"))=2 S @TARGET@(1,0)="0^^V OB file failed" G XVFADD
  1.  ;
  1.  ;Update Prenatal Problem entry
  1.  S:$G(APCDALVR("APCDSMD"))]"" BJPNUPD(90680.01,PIPIEN_",",.01)=APCDALVR("APCDSMD")
  1.  S:$G(APCDALVR("APCDPRI"))]"" BJPNUPD(90680.01,PIPIEN_",",.06)=APCDALVR("APCDPRI")
  1.  S:$G(APCDALVR("APCDSCO"))]"" BJPNUPD(90680.01,PIPIEN_",",.07)=APCDALVR("APCDSCO")
  1.  S:$G(APCDALVR("APCDSTS"))]"" BJPNUPD(90680.01,PIPIEN_",",.08)=APCDALVR("APCDSTS")
  1.  S:$G(APCDALVR("APCDEDD"))]"" BJPNUPD(90680.01,PIPIEN_",",.09)=APCDALVR("APCDEDD")
  1.  S:$G(APCDALVR("APCDPTX"))]"" BJPNUPD(90680.01,PIPIEN_",",.05)=APCDALVR("APCDPTX")
  1.  S:$G(APCDALVR("APCDOEDT"))]"" BJPNUPD(90680.01,PIPIEN_",",1.01)=APCDALVR("APCDOEDT")
  1.  S:$G(APCDALVR("APCDOEBY"))]"" BJPNUPD(90680.01,PIPIEN_",",1.02)=APCDALVR("APCDOEBY")
  1.  S:$G(APCDALVR("APCDDELD"))]"" BJPNUPD(90680.01,PIPIEN_",",2.01)=APCDALVR("APCDDELD")
  1.  S:$G(APCDALVR("APCDDELB"))]"" BJPNUPD(90680.01,PIPIEN_",",2.02)=APCDALVR("APCDDELB")
  1.  S:$G(APCDALVR("APCDDELR"))]"" BJPNUPD(90680.01,PIPIEN_",",2.03)=APCDALVR("APCDDELR")
  1.  S:$G(APCDALVR("APCDDELO"))]"" BJPNUPD(90680.01,PIPIEN_",",2.04)=APCDALVR("APCDDELO")
  1.  S:$G(APCDALVR("NOTE"))]"" BJPNUPD(90680.01,PIPIEN_",",3)=APCDALVR("NOTE")
  1.  S BJPNUPD(90680.01,PIPIEN_",",1.03)=NOW
  1.  S BJPNUPD(90680.01,PIPIEN_",",1.04)=DUZ
  1.  ;
  1.  I $D(BJPNUPD) D FILE^DIE("","BJPNUPD","ERROR")
  1.  I $D(ERROR) S @TARGET@(1,0)="0^^File 90680.01 update failed" G XVFADD
  1.  ;
  1.  ;Set as POV
  1.  I $D(APCDALVR("APCDPOV")) D
  1.  . I APCDALVR("APCDPOV")=1 D POV^BJPNPUP("",VIEN,PIPIEN) Q
  1.  . I APCDALVR("APCDPOV")="" D DPOV^BJPNPUTL("",VIEN,PIPIEN)
  1.  ;
  1.  S @TARGET@(1,0)="1^"_PIPIEN_"^"
  1.  ;
  1. XVFADD ;Restore original APCDALVR
  1.  K APCDALVR M APCDALVR=APCDTMP
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. PROC(PRBIEN,BPIEN,ASTS,PARM,PCNT,II,TYPE,TMP,RESULT) ;EP - Process one entry
  1.  ;
  1.  ;Called from APIP^BJPNAPI
  1.  ;
  1.  NEW DEL,STRM,PNR,OEDT,OEBY,CNT,WRAP,PDSP,STS,LINE,BGO,SMD
  1.  NEW X1,X2,BRNG,ERNG,X,DEDD,API,NVDT,NPDT,NHYP,NEDT,SPACE
  1.  ;
  1.  S $P(SPACE," ",80)=" "
  1.  S PARM=$G(PARM)
  1.  ;
  1.  ;Definitive EDD date range check
  1.  D GETPAR^CIAVMRPC(.NEDT,"BJPN POST DEDD DAYS","SYS",1,"I","")
  1.  ;
  1.  ;If blank default to 70
  1.  I +$G(NEDT)<1 S NEDT=70
  1.  ;
  1.  ;Define formatting parameters
  1.  S NVDT=$S(PARM["V":1,1:"")
  1.  S NPDT=$S(PARM["P":1,1:"")
  1.  S NHYP=$S(PARM["H":1,1:"")
  1.  ;
  1.  ;Skip deletes
  1.  S DEL=$$GET1^DIQ(90680.01,BPIEN_",",2.01,"I") Q:DEL]""
  1.  S DEL=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I") I DEL]"" Q  ;IPL Delete
  1.  ;
  1.  ;Retrieve the entry from the API results
  1.  S BGO=$O(@TMP@("P",PRBIEN,"")) Q:BGO=""   ;Quit if no IPL entry
  1.  S API=$G(@TMP@("P",PRBIEN,BGO)) Q:API=""
  1.  ;
  1.  ;Status - Active Only
  1.  S STS=$$GET1^DIQ(90680.01,BPIEN_",",.08,"I")
  1.  I '$G(ASTS),STS'="A" Q
  1.  ;
  1.  ;Provider Text
  1.  S PNR=$P(API,U,8)
  1.  ;
  1.  ;Tack on Inactive
  1.  I STS'="A" S PNR="(i)"_PNR
  1.  ;
  1.  ;Original Entry Date
  1.  S OEDT=$$FMTE^XLFDT($$GET1^DIQ(9000011,PRBIEN_",",.08,"I"),"2D")
  1.  ;
  1.  ;Original Entry By
  1.  S OEBY=$$GET1^DIQ(9000011,PRBIEN_",",1.03,"E")
  1.  ;
  1.  ;Problem Count
  1.  S PCNT=$G(PCNT)+1 I PCNT>1 S II=II+1,RESULT(II)=" "
  1.  S PDSP=PCNT_") ",PDSP=$E(PDSP,1,4)
  1.  ;
  1.  ;Handle Wrapping
  1.  D WRAP^BJPNPRNT(.WRAP,PNR,76)
  1.  ;
  1.  ;Process each wrapped line
  1.  S WRAP="" F LINE=1:1 S WRAP=$O(WRAP(WRAP)) Q:WRAP=""  D
  1.  . S II=II+1,RESULT(II)=$S(LINE=1:PDSP,1:($E(SPACE,1,4)))_WRAP(WRAP)
  1.  ;
  1.  ;Tack on Date/By
  1.  S II=II+1,RESULT(II)=$E(SPACE,1,5)_"(Entered"_$S(NPDT:"",1:" "_OEDT)_$S(OEBY]"":" by ",1:"")_OEBY_")"
  1.  ;
  1.  ;Pull Definitive EDD
  1.  S DEDD=$$GET1^DIQ(90680.01,BPIEN_",",.09,"I")
  1.  S X1=DEDD,X2=-280 D C^%DTC S BRNG=X
  1.  S X1=DEDD,X2=NEDT D C^%DTC S ERNG=X
  1.  ;
  1.  ;Loop through Visit Instructions (Return All)
  1.  S BGO="" F  S BGO=$O(@TMP@("I",PRBIEN,BGO)) Q:BGO=""  D
  1.  . ;
  1.  . NEW APIRES,NIEN,IENS,DA,SCO,WRAP
  1.  . NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN,VSIT
  1.  . ;
  1.  . S SIGN=""
  1.  . S APIRES=$G(@TMP@("I",PRBIEN,BGO,0)) Q:APIRES=""
  1.  . ;
  1.  . ;Get note date/time entered and by
  1.  . S (DTTM,ILMBY)=""
  1.  . ;
  1.  . ;Note IEN
  1.  . S NIEN=$P(APIRES,U,2) Q:NIEN=""
  1.  . ;
  1.  . ;Get note date/time entered and by - V VISIT INSTRUCTIONS
  1.  . S (DTTM,ILMBY)=""
  1.  . S DTTM=$$GET1^DIQ(9000010.58,NIEN_",",1216,"I")
  1.  . S ILMBY=$$GET1^DIQ(9000010.58,NIEN_",",1217,"I")
  1.  . S SIGN=$P(APIRES,U,13)
  1.  . ;
  1.  . Q:DTTM=""
  1.  . S MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
  1.  . ;
  1.  . ;Get Note
  1.  . S NOTE=$P($G(@TMP@("I",PRBIEN,BGO,1)),U,2)
  1.  . Q:NOTE=""
  1.  . ;
  1.  . ;Note Status
  1.  . S NSTS="A"
  1.  . I DEDD]"",DTTM'<BRNG,DTTM'>ERNG S NSTS="C"
  1.  . S NSTS=$S(VIEN]"":" ",TYPE="C":" ",1:" ("_NSTS_") ")
  1.  . ;
  1.  . ;Determined signed/unsigned
  1.  . S SIGN=$S(SIGN]"":"S",1:"U") Q:SIGN="U"
  1.  . ;
  1.  . ;Set up record
  1.  . ;
  1.  . ;Handle Wrapping
  1.  . D WRAP^BJPNPRNT(.WRAP,$S(NHYP:"",1:"-")_NSTS_NOTE_" ("_$S('NVDT:$$FMTE^XLFDT(DTTM,"2D")_" ",1:"")_$S(MDBY]"":"by ",1:"")_MDBY_")",72,2)
  1.  . ;
  1.  . ;Process each wrapped line
  1.  . S WRAP="" F LINE=1:1 S WRAP=$O(WRAP(WRAP)) Q:WRAP=""  D
  1.  .. S II=II+1,RESULT(II)=$E(SPACE,1,5)_WRAP(WRAP)
  1.  ;
  1.  Q