SCMCPAT ;ALB/ART - PCMMR-RPC to Get Patient Data ;02/05/2015
;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
;
QUIT
;
;Public, Supported ICRs
; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
; #2701 - MPIF001 - ICN
; #10035 - PATIENT FILE
; #10061 - VADPT - Patient file data
;
DIEDON(SCRET,SCDFN) ; Check for patient date of death
;Inputs: SCRET - String for patient DoD - passed by reference
; SCDFN - Patient DFN
;Output: populated SCRET
; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
;
IF $GET(SCDFN)="" DO QUIT
. SET SCRET="-1^Missing DFN parameter."
IF $$GET1^DIQ(2,SCDFN_",",.01)="" DO QUIT
. SET SCRET="-1^Patient was not found."
SET SCRET=+$$GET1^DIQ(2,SCDFN_",",.351,"I")
QUIT
;
PATIENT(SCRET,SCDFN) ; Patient Information
;Inputs: SCRET - String for patient Data - passed by reference
; SCDFN - Patient DFN
;Output: populated SCRET
; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
;DFN^PATIENT NAME^SSN^DOB^AGE^SEX^MARITAL STATUS^ACTIVE DUTY^ADDRESS1^ADDRESS2^ADDRESS3^CITY^STATE^ZIP^COUNTY^TELEPHONE^SENSITIVE^ICN
;
; #10061 - VADPT - Patient file data
; #2701 - MPIF001 - ICN
;
IF $GET(SCDFN)="" DO QUIT
. SET SCRET="-1^Missing DFN parameter"
IF $$GET1^DIQ(2,SCDFN_",",.01)="" DO QUIT
. SET SCRET="-1^Patient was not found."
SET SCRET="-1^Error retrieving patient data"
;
NEW DFN,I,VA,VADM,VAEL,VAERR,VAPA,SCTMP,SCPAT,SCICN
SET DFN=SCDFN
DO DEM^VADPT QUIT:VAERR
DO ADD^VADPT QUIT:VAERR
DO ELIG^VADPT QUIT:VAERR
MERGE SCTMP=VADM
SET SCTMP(10)=$PIECE(SCTMP(10),U,2)
SET SCPAT=SCDFN
FOR I=1,2,3,4,5,10 SET SCPAT=SCPAT_U_$PIECE(SCTMP(I),U)
SET SCPAT=SCPAT_U_$SELECT($PIECE(VAEL(6),U,2)="ACTIVE DUTY":"A",1:"N")
NEW SCTMP
MERGE SCTMP=VAPA
FOR I=5,7 SET SCTMP(I)=$PIECE(SCTMP(I),U,2)
FOR I=1,2,3,4,5,6,7,8 SET SCPAT=SCPAT_U_$PIECE(SCTMP(I),U)
SET SCPAT=SCPAT_U_$$SENSITIV(SCDFN)
SET SCICN=+$$GETICN^MPIF001(SCDFN)
SET SCPAT=SCPAT_U_$SELECT(SCICN>0:SCICN,1:"")
SET SCRET=SCPAT
QUIT
;
SENSITIV(SCDFN) ; Sensitive Patient record check
;Input: SCDFN = Pointer to the Patient file (#2)
;Returns:
; 0 - Patient record IS NOT sensitive
; 1 - Patient record IS sensitive
; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
;
QUIT ''$$GET1^DIQ(38.1,+$GET(SCDFN),2,"I")
;
MAKEOUT(SCRET,SCDFN,SCASSIGN) ;create/update an outpatient profile entry
;Called by RPC - ?????????????????????????
;Input: SCRET - return code - passed by reference
; SCDFN - patient DFN
; SCASSIGN - assignment type
;Output: populated SCRET
;
IF $GET(SCDFN)="" DO QUIT
. SET SCRET="-1^Missing DFN parameter."
IF $GET(SCASSIGN)="" DO QUIT
. SET SCRET="-1^Missing assignment type parameter."
;
NEW SCX,SCOUTFLD,SCBADOUT
SET SCOUTFLD(.04)=$SELECT(SCASSIGN=1:"Y",SCASSIGN=98:"Y",SCASSIGN=99:"N",1:"N")
SET SCRET=$$ACOUTPT^SCAPMC20(SCDFN,"SCOUTFLD","SCBADOUT")
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCPAT 3066 printed Oct 16, 2024@18:41:43 Page 2
SCMCPAT ;ALB/ART - PCMMR-RPC to Get Patient Data ;02/05/2015
+1 ;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
+2 ;
+3 QUIT
+4 ;
+5 ;Public, Supported ICRs
+6 ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
+7 ; #2701 - MPIF001 - ICN
+8 ; #10035 - PATIENT FILE
+9 ; #10061 - VADPT - Patient file data
+10 ;
DIEDON(SCRET,SCDFN) ; Check for patient date of death
+1 ;Inputs: SCRET - String for patient DoD - passed by reference
+2 ; SCDFN - Patient DFN
+3 ;Output: populated SCRET
+4 ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
+5 ;
+6 IF $GET(SCDFN)=""
Begin DoDot:1
+7 SET SCRET="-1^Missing DFN parameter."
End DoDot:1
QUIT
+8 IF $$GET1^DIQ(2,SCDFN_",",.01)=""
Begin DoDot:1
+9 SET SCRET="-1^Patient was not found."
End DoDot:1
QUIT
+10 SET SCRET=+$$GET1^DIQ(2,SCDFN_",",.351,"I")
+11 QUIT
+12 ;
PATIENT(SCRET,SCDFN) ; Patient Information
+1 ;Inputs: SCRET - String for patient Data - passed by reference
+2 ; SCDFN - Patient DFN
+3 ;Output: populated SCRET
+4 ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
+5 ;DFN^PATIENT NAME^SSN^DOB^AGE^SEX^MARITAL STATUS^ACTIVE DUTY^ADDRESS1^ADDRESS2^ADDRESS3^CITY^STATE^ZIP^COUNTY^TELEPHONE^SENSITIVE^ICN
+6 ;
+7 ; #10061 - VADPT - Patient file data
+8 ; #2701 - MPIF001 - ICN
+9 ;
+10 IF $GET(SCDFN)=""
Begin DoDot:1
+11 SET SCRET="-1^Missing DFN parameter"
End DoDot:1
QUIT
+12 IF $$GET1^DIQ(2,SCDFN_",",.01)=""
Begin DoDot:1
+13 SET SCRET="-1^Patient was not found."
End DoDot:1
QUIT
+14 SET SCRET="-1^Error retrieving patient data"
+15 ;
+16 NEW DFN,I,VA,VADM,VAEL,VAERR,VAPA,SCTMP,SCPAT,SCICN
+17 SET DFN=SCDFN
+18 DO DEM^VADPT
if VAERR
QUIT
+19 DO ADD^VADPT
if VAERR
QUIT
+20 DO ELIG^VADPT
if VAERR
QUIT
+21 MERGE SCTMP=VADM
+22 SET SCTMP(10)=$PIECE(SCTMP(10),U,2)
+23 SET SCPAT=SCDFN
+24 FOR I=1,2,3,4,5,10
SET SCPAT=SCPAT_U_$PIECE(SCTMP(I),U)
+25 SET SCPAT=SCPAT_U_$SELECT($PIECE(VAEL(6),U,2)="ACTIVE DUTY":"A",1:"N")
+26 NEW SCTMP
+27 MERGE SCTMP=VAPA
+28 FOR I=5,7
SET SCTMP(I)=$PIECE(SCTMP(I),U,2)
+29 FOR I=1,2,3,4,5,6,7,8
SET SCPAT=SCPAT_U_$PIECE(SCTMP(I),U)
+30 SET SCPAT=SCPAT_U_$$SENSITIV(SCDFN)
+31 SET SCICN=+$$GETICN^MPIF001(SCDFN)
+32 SET SCPAT=SCPAT_U_$SELECT(SCICN>0:SCICN,1:"")
+33 SET SCRET=SCPAT
+34 QUIT
+35 ;
SENSITIV(SCDFN) ; Sensitive Patient record check
+1 ;Input: SCDFN = Pointer to the Patient file (#2)
+2 ;Returns:
+3 ; 0 - Patient record IS NOT sensitive
+4 ; 1 - Patient record IS sensitive
+5 ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
+6 ;
+7 QUIT ''$$GET1^DIQ(38.1,+$GET(SCDFN),2,"I")
+8 ;
MAKEOUT(SCRET,SCDFN,SCASSIGN) ;create/update an outpatient profile entry
+1 ;Called by RPC - ?????????????????????????
+2 ;Input: SCRET - return code - passed by reference
+3 ; SCDFN - patient DFN
+4 ; SCASSIGN - assignment type
+5 ;Output: populated SCRET
+6 ;
+7 IF $GET(SCDFN)=""
Begin DoDot:1
+8 SET SCRET="-1^Missing DFN parameter."
End DoDot:1
QUIT
+9 IF $GET(SCASSIGN)=""
Begin DoDot:1
+10 SET SCRET="-1^Missing assignment type parameter."
End DoDot:1
QUIT
+11 ;
+12 NEW SCX,SCOUTFLD,SCBADOUT
+13 SET SCOUTFLD(.04)=$SELECT(SCASSIGN=1:"Y",SCASSIGN=98:"Y",SCASSIGN=99:"N",1:"N")
+14 SET SCRET=$$ACOUTPT^SCAPMC20(SCDFN,"SCOUTFLD","SCBADOUT")
+15 QUIT
+16 ;
