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

PXAPIOE.m

Go to the documentation of this file.
  1. PXAPIOE ;ALB/MJK,ESW - Supported References for ACRP ; 12/5/02 11:27am
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**39,73,108**;Aug 12, 1996
  1. ;
  1. ;
  1. CPT(PXVIEN,PXERR) ; -- at least one cpt for visit??
  1. ;
  1. N PXOK
  1. S PXOK=0
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALVST(PXVIEN,$G(PXERR)) G CPTQ
  1. ;
  1. S PXOK=($O(^AUPNVCPT("AD",PXVIEN,0))>0)
  1. CPTQ Q PXOK
  1. ;
  1. ;
  1. GETCPT(PXVIEN,PXCPT,PXERR) ; -- get cpt's for visit
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALVST(PXVIEN,$G(PXERR)) G GETCPTQ
  1. ;
  1. N I,CNT S (I,CNT)=0 F S I=$O(^AUPNVCPT("AD",PXVIEN,I)) Q:'I D
  1. . IF $D(^AUPNVCPT(I,0)) S @PXCPT@(I)=^(0),CNT=CNT+1
  1. S @PXCPT=CNT
  1. GETCPTQ Q
  1. ;
  1. CPTARR(PXVIEN,PXCPT,PXERR) ;+API to return all CPT data for a visit.
  1. N IEN,CNT
  1. S (IEN,CNT)=0
  1. Q:'$$VALVST(PXVIEN,$G(PXERR))
  1. F S IEN=$O(^AUPNVCPT("AD",PXVIEN,IEN)) Q:'IEN D
  1. . Q:'$D(^AUPNVCPT(IEN))
  1. . M @PXCPT@(IEN)=^AUPNVCPT(IEN)
  1. . S CNT=CNT+1
  1. S @PXCPT=CNT
  1. Q
  1. ;
  1. DX(PXVIEN,PXERR) ; -- at least one dx for visit??
  1. ;
  1. N PXOK
  1. S PXOK=0
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALVST(PXVIEN,$G(PXERR)) G DXQ
  1. ;
  1. S PXOK=($O(^AUPNVPOV("AD",PXVIEN,0))>0)
  1. DXQ Q PXOK
  1. ;
  1. ;
  1. GETDX(PXVIEN,PXDX,PXERR) ; -- get dx's for visit
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALVST(PXVIEN,$G(PXERR)) G GETDXQ
  1. ;
  1. N I,CNT S (I,CNT)=0 F S I=$O(^AUPNVPOV("AD",PXVIEN,I)) Q:'I D
  1. . IF $D(^AUPNVPOV(I,0)) S @PXDX@(I)=^(0),CNT=CNT+1
  1. S @PXDX=CNT
  1. GETDXQ Q
  1. ;
  1. ;
  1. PRV(PXVIEN,PXERR) ; -- at least one provider for visit?
  1. ;
  1. N PXOK
  1. S PXOK=0
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALVST(PXVIEN,$G(PXERR)) G PRVQ
  1. S PXOK=($O(^AUPNVPRV("AD",PXVIEN,0))>0)
  1. PRVQ Q PXOK
  1. ;
  1. ;
  1. GETPRV(PXVIEN,PXPRV,PXERR) ; -- get provider's for visit;108
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALVST(PXVIEN,$G(PXERR)) G GETPRVQ
  1. ;
  1. ;PX*1*108;look for duplicates to exclude them
  1. N I,CNT,PR,PRS,PS,PP,PRV
  1. S (I,CNT)=0 F S I=$O(^AUPNVPRV("AD",PXVIEN,I)) Q:'I D
  1. .IF $D(^AUPNVPRV(I,0)) D
  1. ..S @PXPRV@(I)=^(0),PR=+@PXPRV@(I),PS=$P(@PXPRV@(I),U,4)
  1. ..IF PS="P" D
  1. ...I 'CNT S PRV=PR,CNT=1 Q
  1. ...I PR=PRV K @PXPRV@(I)
  1. ..I PS="S" S PRS(PR,I)=""
  1. S PR="" F S PR=$O(PRS(PR)) Q:PR="" S I="" D
  1. .F PP=1:1 S I=$O(PRS(PR,I)) Q:I="" D
  1. ..I PR=$G(PRV) K @PXPRV@(I) Q
  1. ..I PP>1 K @PXPRV@(I)
  1. ..E S CNT=CNT+1
  1. S @PXPRV=CNT
  1. GETPRVQ Q
  1. ;
  1. ;
  1. VALVST(PXVIEN,PXERR) ; -- validate visit ien input
  1. ;
  1. ; -- do checks
  1. IF PXVIEN,$D(^AUPNVSIT(PXVIEN,0)) Q 1
  1. ;
  1. ; -- build error msg
  1. N PXIN,PXOUT
  1. S PXIN("ID")=PXVIEN
  1. S PXOUT("ID")=PXVIEN
  1. D BLD^DIALOG(1509000.001,.PXIN,.PXOUT,$G(PXERR),"F")
  1. Q 0
  1. ;
  1. ;
  1. POST ; -- post error action logic
  1. ;ZW DO
  1. ;ZW DIPI
  1. ;ZW DIPE
  1. Q
  1. ;
  1. ;
  1. PDX(VSTPOV,RANK) ; -- set primary dx for V POV entry
  1. ;
  1. N VSTRT,VSTSEQ
  1. N VSTIEN,X
  1. ;
  1. ; -- set up structures
  1. D INIT(.VSTRT,.VSTSEQ)
  1. ;
  1. ; -- set up visit
  1. S X=$G(^AUPNVPOV(VSTPOV,0))
  1. S VSTIEN=+$P(X,U,3)
  1. D VNODES(VSTIEN,VSTRT,VSTSEQ)
  1. ;
  1. ; -- set up dx
  1. D DXNODES(VSTPOV,VSTRT,VSTSEQ)
  1. S $P(@VSTRT@("POV",1,0,"AFTER"),U,12)=RANK
  1. ;
  1. ; -- file change and kill
  1. D FINAL(VSTRT)
  1. Q
  1. ;
  1. ;
  1. PCLASS(VSTPRV) ; -- set provider class for V PRV entry
  1. ;
  1. N VSTRT,VSTSEQ
  1. N VSTIEN,X
  1. ;
  1. ; -- set up structures
  1. D INIT(.VSTRT,.VSTSEQ)
  1. ;
  1. ; -- set up visit
  1. S X=$G(^AUPNVPRV(VSTPRV,0))
  1. S VSTIEN=+$P(X,U,3)
  1. D VNODES(VSTIEN,VSTRT,VSTSEQ)
  1. ;
  1. ; -- set up provider ; pxkmain will automatically set class
  1. D PRVNODES(VSTPRV,VSTRT,VSTSEQ)
  1. ;
  1. ; -- file change and kill
  1. D FINAL(VSTRT)
  1. Q
  1. ;
  1. ;
  1. INIT(VSTRT,VSTSEQ) ; -- set up structures
  1. S VSTRT=$NA(^TMP("PXK",$J))
  1. S VSTSEQ=1
  1. K @VSTRT
  1. S @VSTRT@("SOR")=$O(^PX(839.7,"B","PIMS",0))
  1. Q
  1. ;
  1. ;
  1. FINAL(VSTRT) ; -- file data and clean up
  1. N PXKNOEVT
  1. S PXKNOEVT=1
  1. D EN1^PXKMAIN
  1. K @VSTRT
  1. Q
  1. ;
  1. ;
  1. VNODES(VSTIEN,VSTRT,VSTSEQ) ; -- get visit nodes
  1. N NODE,X
  1. S @VSTRT@("VST",VSTSEQ,"IEN")=VSTIEN
  1. F NODE=0,21,150,800,811,812 D
  1. . S X=$G(^AUPNVSIT(VSTIEN,NODE))
  1. . S @VSTRT@("VST",VSTSEQ,NODE,"BEFORE")=X
  1. . S @VSTRT@("VST",VSTSEQ,NODE,"AFTER")=X
  1. Q
  1. ;
  1. ;
  1. DXNODES(VSTPOV,VSTRT,VSTSEQ) ; -- get dx nodes
  1. N NODE,X
  1. S @VSTRT@("POV",VSTSEQ,"IEN")=VSTPOV
  1. F NODE=0,12,812 D
  1. . S X=$G(^AUPNVPOV(VSTPOV,NODE))
  1. . S @VSTRT@("POV",VSTSEQ,NODE,"BEFORE")=X
  1. . S @VSTRT@("POV",VSTSEQ,NODE,"AFTER")=X
  1. Q
  1. ;
  1. ;
  1. PRVNODES(VSTPRV,VSTRT,VSTSEQ) ; -- get provider nodes
  1. N NODE,X
  1. S @VSTRT@("PRV",VSTSEQ,"IEN")=VSTPRV
  1. F NODE=0,12,812 D
  1. . S X=$G(^AUPNVPRV(VSTPRV,NODE))
  1. . S @VSTRT@("PRV",VSTSEQ,NODE,"BEFORE")=X
  1. . S @VSTRT@("PRV",VSTSEQ,NODE,"AFTER")=X
  1. Q
  1. ;