- PXAPIOE ;ALB/MJK,ESW - Supported References for ACRP ; 12/5/02 11:27am
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**39,73,108**;Aug 12, 1996
- ;
- ;
- CPT(PXVIEN,PXERR) ; -- at least one cpt for visit??
- ;
- N PXOK
- S PXOK=0
- ;
- ; -- do validation checks
- IF '$$VALVST(PXVIEN,$G(PXERR)) G CPTQ
- ;
- S PXOK=($O(^AUPNVCPT("AD",PXVIEN,0))>0)
- CPTQ Q PXOK
- ;
- ;
- GETCPT(PXVIEN,PXCPT,PXERR) ; -- get cpt's for visit
- ;
- ; -- do validation checks
- IF '$$VALVST(PXVIEN,$G(PXERR)) G GETCPTQ
- ;
- N I,CNT S (I,CNT)=0 F S I=$O(^AUPNVCPT("AD",PXVIEN,I)) Q:'I D
- . IF $D(^AUPNVCPT(I,0)) S @PXCPT@(I)=^(0),CNT=CNT+1
- S @PXCPT=CNT
- GETCPTQ Q
- ;
- CPTARR(PXVIEN,PXCPT,PXERR) ;+API to return all CPT data for a visit.
- N IEN,CNT
- S (IEN,CNT)=0
- Q:'$$VALVST(PXVIEN,$G(PXERR))
- F S IEN=$O(^AUPNVCPT("AD",PXVIEN,IEN)) Q:'IEN D
- . Q:'$D(^AUPNVCPT(IEN))
- . M @PXCPT@(IEN)=^AUPNVCPT(IEN)
- . S CNT=CNT+1
- S @PXCPT=CNT
- Q
- ;
- DX(PXVIEN,PXERR) ; -- at least one dx for visit??
- ;
- N PXOK
- S PXOK=0
- ;
- ; -- do validation checks
- IF '$$VALVST(PXVIEN,$G(PXERR)) G DXQ
- ;
- S PXOK=($O(^AUPNVPOV("AD",PXVIEN,0))>0)
- DXQ Q PXOK
- ;
- ;
- GETDX(PXVIEN,PXDX,PXERR) ; -- get dx's for visit
- ;
- ; -- do validation checks
- IF '$$VALVST(PXVIEN,$G(PXERR)) G GETDXQ
- ;
- N I,CNT S (I,CNT)=0 F S I=$O(^AUPNVPOV("AD",PXVIEN,I)) Q:'I D
- . IF $D(^AUPNVPOV(I,0)) S @PXDX@(I)=^(0),CNT=CNT+1
- S @PXDX=CNT
- GETDXQ Q
- ;
- ;
- PRV(PXVIEN,PXERR) ; -- at least one provider for visit?
- ;
- N PXOK
- S PXOK=0
- ;
- ; -- do validation checks
- IF '$$VALVST(PXVIEN,$G(PXERR)) G PRVQ
- S PXOK=($O(^AUPNVPRV("AD",PXVIEN,0))>0)
- PRVQ Q PXOK
- ;
- ;
- GETPRV(PXVIEN,PXPRV,PXERR) ; -- get provider's for visit;108
- ;
- ; -- do validation checks
- IF '$$VALVST(PXVIEN,$G(PXERR)) G GETPRVQ
- ;
- ;PX*1*108;look for duplicates to exclude them
- N I,CNT,PR,PRS,PS,PP,PRV
- S (I,CNT)=0 F S I=$O(^AUPNVPRV("AD",PXVIEN,I)) Q:'I D
- .IF $D(^AUPNVPRV(I,0)) D
- ..S @PXPRV@(I)=^(0),PR=+@PXPRV@(I),PS=$P(@PXPRV@(I),U,4)
- ..IF PS="P" D
- ...I 'CNT S PRV=PR,CNT=1 Q
- ...I PR=PRV K @PXPRV@(I)
- ..I PS="S" S PRS(PR,I)=""
- S PR="" F S PR=$O(PRS(PR)) Q:PR="" S I="" D
- .F PP=1:1 S I=$O(PRS(PR,I)) Q:I="" D
- ..I PR=$G(PRV) K @PXPRV@(I) Q
- ..I PP>1 K @PXPRV@(I)
- ..E S CNT=CNT+1
- S @PXPRV=CNT
- GETPRVQ Q
- ;
- ;
- VALVST(PXVIEN,PXERR) ; -- validate visit ien input
- ;
- ; -- do checks
- IF PXVIEN,$D(^AUPNVSIT(PXVIEN,0)) Q 1
- ;
- ; -- build error msg
- N PXIN,PXOUT
- S PXIN("ID")=PXVIEN
- S PXOUT("ID")=PXVIEN
- D BLD^DIALOG(1509000.001,.PXIN,.PXOUT,$G(PXERR),"F")
- Q 0
- ;
- ;
- POST ; -- post error action logic
- ;ZW DO
- ;ZW DIPI
- ;ZW DIPE
- Q
- ;
- ;
- PDX(VSTPOV,RANK) ; -- set primary dx for V POV entry
- ;
- N VSTRT,VSTSEQ
- N VSTIEN,X
- ;
- ; -- set up structures
- D INIT(.VSTRT,.VSTSEQ)
- ;
- ; -- set up visit
- S X=$G(^AUPNVPOV(VSTPOV,0))
- S VSTIEN=+$P(X,U,3)
- D VNODES(VSTIEN,VSTRT,VSTSEQ)
- ;
- ; -- set up dx
- D DXNODES(VSTPOV,VSTRT,VSTSEQ)
- S $P(@VSTRT@("POV",1,0,"AFTER"),U,12)=RANK
- ;
- ; -- file change and kill
- D FINAL(VSTRT)
- Q
- ;
- ;
- PCLASS(VSTPRV) ; -- set provider class for V PRV entry
- ;
- N VSTRT,VSTSEQ
- N VSTIEN,X
- ;
- ; -- set up structures
- D INIT(.VSTRT,.VSTSEQ)
- ;
- ; -- set up visit
- S X=$G(^AUPNVPRV(VSTPRV,0))
- S VSTIEN=+$P(X,U,3)
- D VNODES(VSTIEN,VSTRT,VSTSEQ)
- ;
- ; -- set up provider ; pxkmain will automatically set class
- D PRVNODES(VSTPRV,VSTRT,VSTSEQ)
- ;
- ; -- file change and kill
- D FINAL(VSTRT)
- Q
- ;
- ;
- INIT(VSTRT,VSTSEQ) ; -- set up structures
- S VSTRT=$NA(^TMP("PXK",$J))
- S VSTSEQ=1
- K @VSTRT
- S @VSTRT@("SOR")=$O(^PX(839.7,"B","PIMS",0))
- Q
- ;
- ;
- FINAL(VSTRT) ; -- file data and clean up
- N PXKNOEVT
- S PXKNOEVT=1
- D EN1^PXKMAIN
- K @VSTRT
- Q
- ;
- ;
- VNODES(VSTIEN,VSTRT,VSTSEQ) ; -- get visit nodes
- N NODE,X
- S @VSTRT@("VST",VSTSEQ,"IEN")=VSTIEN
- F NODE=0,21,150,800,811,812 D
- . S X=$G(^AUPNVSIT(VSTIEN,NODE))
- . S @VSTRT@("VST",VSTSEQ,NODE,"BEFORE")=X
- . S @VSTRT@("VST",VSTSEQ,NODE,"AFTER")=X
- Q
- ;
- ;
- DXNODES(VSTPOV,VSTRT,VSTSEQ) ; -- get dx nodes
- N NODE,X
- S @VSTRT@("POV",VSTSEQ,"IEN")=VSTPOV
- F NODE=0,12,812 D
- . S X=$G(^AUPNVPOV(VSTPOV,NODE))
- . S @VSTRT@("POV",VSTSEQ,NODE,"BEFORE")=X
- . S @VSTRT@("POV",VSTSEQ,NODE,"AFTER")=X
- Q
- ;
- ;
- PRVNODES(VSTPRV,VSTRT,VSTSEQ) ; -- get provider nodes
- N NODE,X
- S @VSTRT@("PRV",VSTSEQ,"IEN")=VSTPRV
- F NODE=0,12,812 D
- . S X=$G(^AUPNVPRV(VSTPRV,NODE))
- . S @VSTRT@("PRV",VSTSEQ,NODE,"BEFORE")=X
- . S @VSTRT@("PRV",VSTSEQ,NODE,"AFTER")=X
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIOE 4493 printed Feb 18, 2025@23:52:33 Page 2
- 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
- +2 ;
- +3 ;
- CPT(PXVIEN,PXERR) ; -- at least one cpt for visit??
- +1 ;
- +2 NEW PXOK
- +3 SET PXOK=0
- +4 ;
- +5 ; -- do validation checks
- +6 IF '$$VALVST(PXVIEN,$GET(PXERR))
- GOTO CPTQ
- +7 ;
- +8 SET PXOK=($ORDER(^AUPNVCPT("AD",PXVIEN,0))>0)
- CPTQ QUIT PXOK
- +1 ;
- +2 ;
- GETCPT(PXVIEN,PXCPT,PXERR) ; -- get cpt's for visit
- +1 ;
- +2 ; -- do validation checks
- +3 IF '$$VALVST(PXVIEN,$GET(PXERR))
- GOTO GETCPTQ
- +4 ;
- +5 NEW I,CNT
- SET (I,CNT)=0
- FOR
- SET I=$ORDER(^AUPNVCPT("AD",PXVIEN,I))
- if 'I
- QUIT
- Begin DoDot:1
- +6 IF $DATA(^AUPNVCPT(I,0))
- SET @PXCPT@(I)=^(0)
- SET CNT=CNT+1
- End DoDot:1
- +7 SET @PXCPT=CNT
- GETCPTQ QUIT
- +1 ;
- CPTARR(PXVIEN,PXCPT,PXERR) ;+API to return all CPT data for a visit.
- +1 NEW IEN,CNT
- +2 SET (IEN,CNT)=0
- +3 if '$$VALVST(PXVIEN,$GET(PXERR))
- QUIT
- +4 FOR
- SET IEN=$ORDER(^AUPNVCPT("AD",PXVIEN,IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +5 if '$DATA(^AUPNVCPT(IEN))
- QUIT
- +6 MERGE @PXCPT@(IEN)=^AUPNVCPT(IEN)
- +7 SET CNT=CNT+1
- End DoDot:1
- +8 SET @PXCPT=CNT
- +9 QUIT
- +10 ;
- DX(PXVIEN,PXERR) ; -- at least one dx for visit??
- +1 ;
- +2 NEW PXOK
- +3 SET PXOK=0
- +4 ;
- +5 ; -- do validation checks
- +6 IF '$$VALVST(PXVIEN,$GET(PXERR))
- GOTO DXQ
- +7 ;
- +8 SET PXOK=($ORDER(^AUPNVPOV("AD",PXVIEN,0))>0)
- DXQ QUIT PXOK
- +1 ;
- +2 ;
- GETDX(PXVIEN,PXDX,PXERR) ; -- get dx's for visit
- +1 ;
- +2 ; -- do validation checks
- +3 IF '$$VALVST(PXVIEN,$GET(PXERR))
- GOTO GETDXQ
- +4 ;
- +5 NEW I,CNT
- SET (I,CNT)=0
- FOR
- SET I=$ORDER(^AUPNVPOV("AD",PXVIEN,I))
- if 'I
- QUIT
- Begin DoDot:1
- +6 IF $DATA(^AUPNVPOV(I,0))
- SET @PXDX@(I)=^(0)
- SET CNT=CNT+1
- End DoDot:1
- +7 SET @PXDX=CNT
- GETDXQ QUIT
- +1 ;
- +2 ;
- PRV(PXVIEN,PXERR) ; -- at least one provider for visit?
- +1 ;
- +2 NEW PXOK
- +3 SET PXOK=0
- +4 ;
- +5 ; -- do validation checks
- +6 IF '$$VALVST(PXVIEN,$GET(PXERR))
- GOTO PRVQ
- +7 SET PXOK=($ORDER(^AUPNVPRV("AD",PXVIEN,0))>0)
- PRVQ QUIT PXOK
- +1 ;
- +2 ;
- GETPRV(PXVIEN,PXPRV,PXERR) ; -- get provider's for visit;108
- +1 ;
- +2 ; -- do validation checks
- +3 IF '$$VALVST(PXVIEN,$GET(PXERR))
- GOTO GETPRVQ
- +4 ;
- +5 ;PX*1*108;look for duplicates to exclude them
- +6 NEW I,CNT,PR,PRS,PS,PP,PRV
- +7 SET (I,CNT)=0
- FOR
- SET I=$ORDER(^AUPNVPRV("AD",PXVIEN,I))
- if 'I
- QUIT
- Begin DoDot:1
- +8 IF $DATA(^AUPNVPRV(I,0))
- Begin DoDot:2
- +9 SET @PXPRV@(I)=^(0)
- SET PR=+@PXPRV@(I)
- SET PS=$PIECE(@PXPRV@(I),U,4)
- +10 IF PS="P"
- Begin DoDot:3
- +11 IF 'CNT
- SET PRV=PR
- SET CNT=1
- QUIT
- +12 IF PR=PRV
- KILL @PXPRV@(I)
- End DoDot:3
- +13 IF PS="S"
- SET PRS(PR,I)=""
- End DoDot:2
- End DoDot:1
- +14 SET PR=""
- FOR
- SET PR=$ORDER(PRS(PR))
- if PR=""
- QUIT
- SET I=""
- Begin DoDot:1
- +15 FOR PP=1:1
- SET I=$ORDER(PRS(PR,I))
- if I=""
- QUIT
- Begin DoDot:2
- +16 IF PR=$GET(PRV)
- KILL @PXPRV@(I)
- QUIT
- +17 IF PP>1
- KILL @PXPRV@(I)
- +18 IF '$TEST
- SET CNT=CNT+1
- End DoDot:2
- End DoDot:1
- +19 SET @PXPRV=CNT
- GETPRVQ QUIT
- +1 ;
- +2 ;
- VALVST(PXVIEN,PXERR) ; -- validate visit ien input
- +1 ;
- +2 ; -- do checks
- +3 IF PXVIEN
- IF $DATA(^AUPNVSIT(PXVIEN,0))
- QUIT 1
- +4 ;
- +5 ; -- build error msg
- +6 NEW PXIN,PXOUT
- +7 SET PXIN("ID")=PXVIEN
- +8 SET PXOUT("ID")=PXVIEN
- +9 DO BLD^DIALOG(1509000.001,.PXIN,.PXOUT,$GET(PXERR),"F")
- +10 QUIT 0
- +11 ;
- +12 ;
- POST ; -- post error action logic
- +1 ;ZW DO
- +2 ;ZW DIPI
- +3 ;ZW DIPE
- +4 QUIT
- +5 ;
- +6 ;
- PDX(VSTPOV,RANK) ; -- set primary dx for V POV entry
- +1 ;
- +2 NEW VSTRT,VSTSEQ
- +3 NEW VSTIEN,X
- +4 ;
- +5 ; -- set up structures
- +6 DO INIT(.VSTRT,.VSTSEQ)
- +7 ;
- +8 ; -- set up visit
- +9 SET X=$GET(^AUPNVPOV(VSTPOV,0))
- +10 SET VSTIEN=+$PIECE(X,U,3)
- +11 DO VNODES(VSTIEN,VSTRT,VSTSEQ)
- +12 ;
- +13 ; -- set up dx
- +14 DO DXNODES(VSTPOV,VSTRT,VSTSEQ)
- +15 SET $PIECE(@VSTRT@("POV",1,0,"AFTER"),U,12)=RANK
- +16 ;
- +17 ; -- file change and kill
- +18 DO FINAL(VSTRT)
- +19 QUIT
- +20 ;
- +21 ;
- PCLASS(VSTPRV) ; -- set provider class for V PRV entry
- +1 ;
- +2 NEW VSTRT,VSTSEQ
- +3 NEW VSTIEN,X
- +4 ;
- +5 ; -- set up structures
- +6 DO INIT(.VSTRT,.VSTSEQ)
- +7 ;
- +8 ; -- set up visit
- +9 SET X=$GET(^AUPNVPRV(VSTPRV,0))
- +10 SET VSTIEN=+$PIECE(X,U,3)
- +11 DO VNODES(VSTIEN,VSTRT,VSTSEQ)
- +12 ;
- +13 ; -- set up provider ; pxkmain will automatically set class
- +14 DO PRVNODES(VSTPRV,VSTRT,VSTSEQ)
- +15 ;
- +16 ; -- file change and kill
- +17 DO FINAL(VSTRT)
- +18 QUIT
- +19 ;
- +20 ;
- INIT(VSTRT,VSTSEQ) ; -- set up structures
- +1 SET VSTRT=$NAME(^TMP("PXK",$JOB))
- +2 SET VSTSEQ=1
- +3 KILL @VSTRT
- +4 SET @VSTRT@("SOR")=$ORDER(^PX(839.7,"B","PIMS",0))
- +5 QUIT
- +6 ;
- +7 ;
- FINAL(VSTRT) ; -- file data and clean up
- +1 NEW PXKNOEVT
- +2 SET PXKNOEVT=1
- +3 DO EN1^PXKMAIN
- +4 KILL @VSTRT
- +5 QUIT
- +6 ;
- +7 ;
- VNODES(VSTIEN,VSTRT,VSTSEQ) ; -- get visit nodes
- +1 NEW NODE,X
- +2 SET @VSTRT@("VST",VSTSEQ,"IEN")=VSTIEN
- +3 FOR NODE=0,21,150,800,811,812
- Begin DoDot:1
- +4 SET X=$GET(^AUPNVSIT(VSTIEN,NODE))
- +5 SET @VSTRT@("VST",VSTSEQ,NODE,"BEFORE")=X
- +6 SET @VSTRT@("VST",VSTSEQ,NODE,"AFTER")=X
- End DoDot:1
- +7 QUIT
- +8 ;
- +9 ;
- DXNODES(VSTPOV,VSTRT,VSTSEQ) ; -- get dx nodes
- +1 NEW NODE,X
- +2 SET @VSTRT@("POV",VSTSEQ,"IEN")=VSTPOV
- +3 FOR NODE=0,12,812
- Begin DoDot:1
- +4 SET X=$GET(^AUPNVPOV(VSTPOV,NODE))
- +5 SET @VSTRT@("POV",VSTSEQ,NODE,"BEFORE")=X
- +6 SET @VSTRT@("POV",VSTSEQ,NODE,"AFTER")=X
- End DoDot:1
- +7 QUIT
- +8 ;
- +9 ;
- PRVNODES(VSTPRV,VSTRT,VSTSEQ) ; -- get provider nodes
- +1 NEW NODE,X
- +2 SET @VSTRT@("PRV",VSTSEQ,"IEN")=VSTPRV
- +3 FOR NODE=0,12,812
- Begin DoDot:1
- +4 SET X=$GET(^AUPNVPRV(VSTPRV,NODE))
- +5 SET @VSTRT@("PRV",VSTSEQ,NODE,"BEFORE")=X
- +6 SET @VSTRT@("PRV",VSTSEQ,NODE,"AFTER")=X
- End DoDot:1
- +7 QUIT
- +8 ;