- AGSSPRT ; IHS/ASDS/EFG - SSN VERIFICATION FROM NPIRS/SSA ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- ;
- K DUOUT,DFOUT,DIRUT,DTOUT
- LOOP ;
- S AGSDFN=0 F S AGSDFN=$O(^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN)) Q:'AGSDFN Q:($G(DUOUT)!$G(DFOUT)!$G(DURUT)!$G(DTOUT)) S AGSCREC=^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN) D PRINT
- Q
- PRINT ;
- U IO D AGSSPG Q:($G(DIRUT)!$G(DUOUT)!$G(DFOUT)!$G(DTOUT))
- D LVAR,PATL ;Print the info from Local database
- I AGSCREC]"" D
- .D CVAR,PATC ;Print the info from NPIRS
- E D ;else
- .W !! ;Allow for no record printed
- Q
- VARS ;
- CVARS ;
- CVAR ;
- S AGSUFAC=$P(AGSCREC,U)
- S AGSHRN=+$P(AGSCREC,U,2)
- S AGSCSSN1=+$P(AGSCREC,U,3)
- S AGSCLN=$P(AGSCREC,U,4)
- S AGSCFN=$P(AGSCREC,U,5)
- S AGSCMN=$P(AGSCREC,U,6)
- S AGSCDOB=$P(AGSCREC,U,7)-17000000
- S AGSCSX=$P(AGSCREC,U,8)
- S AGSCVC=$P(AGSCREC,U,9)
- S AGSCSSN2=+$P(AGSCREC,U,10)
- F AGSX="AGSCLN","AGSCFN","AGSCMN" S AGSY=$L(@AGSX) I AGSY F AGSI=AGSY:-1:0 Q:$E(@AGSX,AGSI)]" " S @AGSX=$E(@AGSX,0,AGSI-1)
- S AGSCNM=AGSCLN_","_AGSCFN
- S:AGSCVC="V" AGSCSSN2=AGSCSSN1
- ECVAR Q
- LVAR ;
- S AG0=^DPT(AGSDFN,0),AGSHRN=$G(^AUPNPAT(AGSDFN,41,AGSSITE,0)),AGSHRN=$P(AGSHRN,U,2)
- S AGSLNM=$P(AG0,U),AGSLSSN=$P(AG0,U,9),AGSLSX=$P(AG0,U,2)
- S AGSLDOB=$P(AG0,U,3)
- ELVAR Q
- PATL ;
- U IO W !,AGSHRN,?8,AGSLNM,?35,"L: ",AGSLSSN,?49,"I: ",$J(AGSDFN,9),?64,AGSLVC,?66,AGSLSX,?68,$$MDT(AGSLDOB)
- Q
- PATC ;
- W !,AGSHRN,?8,AGSCNM,?35,"S: ",AGSCSSN2,?49,"D: ",$J(AGSCSSN1,9),?64,AGSCVC,?66,AGSCSX,?68,$$MDT(AGSCDOB),!
- Q
- LAST ;
- AGSSPG ;EP - page controller
- Q:($Y<(IOSL-4))!($G(DOUT)!$G(DFOUT))
- S AGSSPG=$G(AGSSPG)+1
- I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR
- Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
- D AGSSHDR,AGSSHD
- Q
- AGSSHDR ;EP - write page header
- W:$Y @IOF W ! Q:'$D(AGSSHDR) S:'$D(AGSSLINE) $P(AGSSLINE,"-",IOM-2)="" S:'$D(AGSSPG) AGSSPG=1 I '$D(AGSSDT) S %H=$H D YX^%DTC S AGSSDT=Y
- U IO W ?(IOM-40-$L(AGSSHDR)/2),AGSSHDR,?(IOM-40),AGSSDT,?(IOM-10),"PAGE: ",AGSSPG,!,AGSSLINE
- Q
- AGSSHD ;EP - write column header / message
- I AGSSPG=1 W !,?3,"Local Data",!,?5,"HRN",?10,"Name ",?20,"L: Local SSN",?44,"I: Internal Entry Number for patient"
- I AGSSPG=1,"RD,RN,RP"[AGSGLO W !,?3,"NPIRS Data",!,?5,"HRN",?10,"Name ",?20,"S: Social Security SSN ",?44,"D: IHS NPIRS SSN",!,?5,"Codes: V-Verified A-Only one on file *-1 digit differs",!
- W !,"HRN",?8,"Name",?35,"SSNs",?60,"Code",?65,"Sex",?70,"DOB"
- Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
- EAGSSPG Q
- MDT(X) ;EP - date format dd mmm yyyy
- I X="" Q X
- S X=+$E(X,6,7)_" "_$P($T(MTHS+1),";;",+$E(X,4,5)+1)_" "_($E(X,1,3)+1700)
- S X=$J(X,12)
- Q X
- MTHS ;months
- ;;JAN;;FEB;;MAR;;APR;;MAY;;JUN;;JUL;;AUG;;SEP;;OCT;;NOV;;DEC
- AGSSPRT ; IHS/ASDS/EFG - SSN VERIFICATION FROM NPIRS/SSA ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 ;
- +3 KILL DUOUT,DFOUT,DIRUT,DTOUT
- LOOP ;
- +1 SET AGSDFN=0
- FOR
- SET AGSDFN=$ORDER(^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN))
- IF 'AGSDFN
- QUIT
- IF ($GET(DUOUT)!$GET(DFOUT)!$GET(DURUT)!$GET(DTOUT))
- QUIT
- SET AGSCREC=^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN)
- DO PRINT
- +2 QUIT
- PRINT ;
- +1 USE IO
- DO AGSSPG
- IF ($GET(DIRUT)!$GET(DUOUT)!$GET(DFOUT)!$GET(DTOUT))
- QUIT
- +2 ;Print the info from Local database
- DO LVAR
- DO PATL
- +3 IF AGSCREC]""
- Begin DoDot:1
- +4 ;Print the info from NPIRS
- DO CVAR
- DO PATC
- End DoDot:1
- +5 ;else
- IF '$TEST
- Begin DoDot:1
- +6 ;Allow for no record printed
- WRITE !!
- End DoDot:1
- +7 QUIT
- VARS ;
- CVARS ;
- CVAR ;
- +1 SET AGSUFAC=$PIECE(AGSCREC,U)
- +2 SET AGSHRN=+$PIECE(AGSCREC,U,2)
- +3 SET AGSCSSN1=+$PIECE(AGSCREC,U,3)
- +4 SET AGSCLN=$PIECE(AGSCREC,U,4)
- +5 SET AGSCFN=$PIECE(AGSCREC,U,5)
- +6 SET AGSCMN=$PIECE(AGSCREC,U,6)
- +7 SET AGSCDOB=$PIECE(AGSCREC,U,7)-17000000
- +8 SET AGSCSX=$PIECE(AGSCREC,U,8)
- +9 SET AGSCVC=$PIECE(AGSCREC,U,9)
- +10 SET AGSCSSN2=+$PIECE(AGSCREC,U,10)
- +11 FOR AGSX="AGSCLN","AGSCFN","AGSCMN"
- SET AGSY=$LENGTH(@AGSX)
- IF AGSY
- FOR AGSI=AGSY:-1:0
- IF $EXTRACT(@AGSX,AGSI)]" "
- QUIT
- SET @AGSX=$EXTRACT(@AGSX,0,AGSI-1)
- +12 SET AGSCNM=AGSCLN_","_AGSCFN
- +13 IF AGSCVC="V"
- SET AGSCSSN2=AGSCSSN1
- ECVAR QUIT
- LVAR ;
- +1 SET AG0=^DPT(AGSDFN,0)
- SET AGSHRN=$GET(^AUPNPAT(AGSDFN,41,AGSSITE,0))
- SET AGSHRN=$PIECE(AGSHRN,U,2)
- +2 SET AGSLNM=$PIECE(AG0,U)
- SET AGSLSSN=$PIECE(AG0,U,9)
- SET AGSLSX=$PIECE(AG0,U,2)
- +3 SET AGSLDOB=$PIECE(AG0,U,3)
- ELVAR QUIT
- PATL ;
- +1 USE IO
- WRITE !,AGSHRN,?8,AGSLNM,?35,"L: ",AGSLSSN,?49,"I: ",$JUSTIFY(AGSDFN,9),?64,AGSLVC,?66,AGSLSX,?68,$$MDT(AGSLDOB)
- +2 QUIT
- PATC ;
- +1 WRITE !,AGSHRN,?8,AGSCNM,?35,"S: ",AGSCSSN2,?49,"D: ",$JUSTIFY(AGSCSSN1,9),?64,AGSCVC,?66,AGSCSX,?68,$$MDT(AGSCDOB),!
- +2 QUIT
- LAST ;
- AGSSPG ;EP - page controller
- +1 IF ($Y<(IOSL-4))!($GET(DOUT)!$GET(DFOUT))
- QUIT
- +2 SET AGSSPG=$GET(AGSSPG)+1
- +3 IF $EXTRACT(IOST)="C"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +4 IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
- QUIT
- +5 DO AGSSHDR
- DO AGSSHD
- +6 QUIT
- AGSSHDR ;EP - write page header
- +1 IF $Y
- WRITE @IOF
- WRITE !
- IF '$DATA(AGSSHDR)
- QUIT
- IF '$DATA(AGSSLINE)
- SET $PIECE(AGSSLINE,"-",IOM-2)=""
- IF '$DATA(AGSSPG)
- SET AGSSPG=1
- IF '$DATA(AGSSDT)
- SET %H=$HOROLOG
- DO YX^%DTC
- SET AGSSDT=Y
- +2 USE IO
- WRITE ?(IOM-40-$LENGTH(AGSSHDR)/2),AGSSHDR,?(IOM-40),AGSSDT,?(IOM-10),"PAGE: ",AGSSPG,!,AGSSLINE
- +3 QUIT
- AGSSHD ;EP - write column header / message
- +1 IF AGSSPG=1
- WRITE !,?3,"Local Data",!,?5,"HRN",?10,"Name ",?20,"L: Local SSN",?44,"I: Internal Entry Number for patient"
- +2 IF AGSSPG=1
- IF "RD,RN,RP"[AGSGLO
- WRITE !,?3,"NPIRS Data",!,?5,"HRN",?10,"Name ",?20,"S: Social Security SSN ",?44,"D: IHS NPIRS SSN",!,?5,"Codes: V-Verified A-Only one on file *-1 digit differs",!
- +3 WRITE !,"HRN",?8,"Name",?35,"SSNs",?60,"Code",?65,"Sex",?70,"DOB"
- +4 IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
- QUIT
- EAGSSPG QUIT
- MDT(X) ;EP - date format dd mmm yyyy
- +1 IF X=""
- QUIT X
- +2 SET X=+$EXTRACT(X,6,7)_" "_$PIECE($TEXT(MTHS+1),";;",+$EXTRACT(X,4,5)+1)_" "_($EXTRACT(X,1,3)+1700)
- +3 SET X=$JUSTIFY(X,12)
- +4 QUIT X
- MTHS ;months
- +1 ;;JAN;;FEB;;MAR;;APR;;MAY;;JUN;;JUL;;AUG;;SEP;;OCT;;NOV;;DEC
