- ABMDF35E ; IHS/SD/SDR - Set HCFA1500 (02/12) Print Array - Part 5 ;
- ;;2.6;IHS 3P BILLING SYSTEM;**13,21,22**;NOV 12, 2009;Build 418
- ;IHS/SD/SDR - 2.6*21 - HEAT223194 - Fixed EPSDT field so it will print either the second character from the referral
- ; or an 'U' for no referral.
- ;IHS/SD/SDR 2.6*22 HEAT335246 Added code to print the appropriate CPT based on if the NDC prompt is answered or not.
- ;
- ; *********************************************************************
- ;
- EMG ;EP for setting Emerg or Special Prog variable
- ;S (ABM,ABM("EPSDT"))=0 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- S ABM=0 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- S ABM("EPSDT")="" ;abm*2.6*21 IHS/SD/SDR HEAT223194
- F S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM)) Q:'ABM D
- .S ABM("X")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,0),U)
- .Q:ABM("X")=""
- .;I $P(^ABMDCODE(ABM("X"),0),U)["EPSDT"!($P(^(0),U))["FAMILY" S ABM("EPSDT")=1 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- .I ($P(^ABMDCODE(ABM("X"),0),U,3)["EPSDT") D ;abm*2.6*21 IHS/SD/SDR HEAT223194
- ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,0)),U,2)="N" S ABM("EPSDT")="U" Q ;abm*2.6*21 IHS/SD/SDR HEAT223194
- ..S ABM("EPSDT")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,1,0)) ;abm*2.6*21 IHS/SD/SDR HEAT223194
- ..S ABM("EPSDT")=$E($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,1,ABM("EPSDT"),0)),U),2) ;abm*2.6*21 IHS/SD/SDR HEAT223194
- .I ($P(^(0),U,3)["FAMILY") S ABM("EPSDT")="X" ;abm*2.6*21 IHS/SD/SDR HEAT223194
- S ABM("EMG")=$S($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,5)="Y":1,1:0)
- Q
- ;
- PROC ;EP for setting the procedure portion of the ABMF array
- ; input vars: ABMS(ABMS) - the procedure line in internal format
- ; ABMS("I") - the current line number
- ;
- ; output vars: ABMF(ABMS("I")) - procedure line in external format
- ; ABMF(ABMS("I")-1) - top line for extended descriptions
- ;
- K %DT
- S ABMFDT=$P(ABMS(ABMS),U,2) ;Service date from
- S X=$P($P(ABMS(ABMS),U,2),"@") ;Service date from
- D ^%DT
- S $P(ABMS(ABMS),U,2)=Y ; Service date from in FM Format
- S ABMTDT=$P(ABMS(ABMS),U,3) ;Service date to
- S X=$P($P(ABMS(ABMS),U,3),"@") ;Service date to
- D ^%DT
- S $P(ABMS(ABMS),U,3)=Y ; Service date to in FM format
- S ABMR(ABMS,ABMLN)=""
- S ABMR(ABMS,ABMLN)=$P(ABMS(ABMS),U,2,3) ; Form locator 24A
- ;check if time on charge (anes); if so, add as line 1
- I ABMFDT["@" D
- .S $P(ABMR(ABMS,ABMLN-1),U)="7Begin "_$TR($P(ABMFDT,"@",2),":")
- .S $P(ABMR(ABMS,ABMLN-1),U)=$P(ABMR(ABMS,ABMLN-1),U)_" End "_$TR($P(ABMTDT,"@",2),":")
- ;
- ; Set Place of service ; Form locator 24B
- ; 21 if visit type is inpatient
- ; 24 if visit type is ambulatory surgery
- ; 23 if clinic is emergency medicine (code 30)
- ; 11 for all other cases
- I $P(ABMS(ABMS),U,10) S $P(ABMR(ABMS,ABMLN),U,3)=$P($G(^ABMDCODE($P(ABMS(ABMS),U,10),0)),U)
- E D
- .S $P(ABMR(ABMS,ABMLN),U,3)=$S(ABMP("VTYP")=111!($G(ABMP("BTYP"))=111):21,ABMP("BTYP")=831:24,1:11)
- .; if Place of service set to 11 check to see if pointer exists
- .; in Parameter file to Code file and use it
- .I $P(ABMR(ABMS,ABMLN),U,3)=11 D
- ..S ABMPTR=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),"^",6)
- ..S:ABMPTR="" ABMPTR=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",6) Q:'ABMPTR
- ..Q:'$D(^ABMDCODE(ABMPTR,0))
- ..S $P(ABMR(ABMS,ABMLN),U,3)=$P(^ABMDCODE(ABMPTR,0),U)
- .I $P($G(^DIC(40.7,+ABMP("CLN"),0)),"^",2)=30 D
- ..S $P(ABMR(ABMS,ABMLN),U,3)=23
- ;
- ; Set CPT/HCPCS ; Form locator 24D
- I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y" S $P(ABMR(ABMS,ABMLN),U,5)=$P(ABMS(ABMS),U,4) ;abm*2.6*22 IHS/SD/SDR HEAT335246
- I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)]"" D
- .I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y" Q ;don't write default CPT if they want NDC to print ;abm*2.6*22 IHS/SD/SDR HEAT335246
- .S $P(ABMR(ABMS,ABMLN),U,5)=$P($$CPT^ABMCVAPI($P(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,16),ABMP("VDT")),U,2) ;CSV-c
- E I $P($G(ABMS(ABMS)),U,4)]"" D I 1
- .S $P(ABMR(ABMS,ABMLN),U,5)=" "_$P(ABMS(ABMS),U,4)
- .; If CPT code, and modifier exists, add it
- .S $P(ABMR(ABMS,ABMLN),U,5)=" "_$P(ABMR(ABMS,ABMLN),U,5)_$S($E($P(ABMS(ABMS),U,8))="#":" "_$P($P(ABMS(ABMS),U,8)," "),1:"")
- .;S:$G(ABM("EPSDT")) $P(ABMR(ABMS,ABMLN),U,9)="X" ; Form locator 24H ;abm*2.6*21 IHS/SD/SDR HEAT223194
- .S:$G(ABM("EPSDT"))'="" $P(ABMR(ABMS,ABMLN),U,9)=$G(ABM("EPSDT")) ; Form locator 24H ;abm*2.6*21 IHS/SD/SDR HEAT223194
- .S:$G(ABM("EMG")) $P(ABMR(ABMS,ABMLN),U,4)="X" ; Form locator 24C
- E D
- .I $P($G(^AUTNINS(ABMP("INS"),0)),U)["PHC MEDICAID" S $P(ABMS(ABMS),U,8)=$TR($P(ABMS(ABMS),U,8),"-")
- S:$P(ABMR(ABMS,ABMLN),U,5)["NO CODE SELECTED" $P(ABMR(ABMS,ABMLN),U,5)=""
- I $L($P(ABMS(ABMS),U,8))>16,($E($P(ABMS(ABMS),U,8),1,2)="N4") D
- .S ABMU("LNG")=60
- .S ABMU("TXT")=$P(ABMS(ABMS),U,8)
- .S ABMU=3
- .D LNG^ABMDWRAP
- .S ABMLND=ABMLN-1,J=0
- .F S J=$O(ABMU(J)) Q:+J=0!(+J>2) D
- ..S $P(ABMR(ABMS,ABMLND),U)=$G(ABMU(J))
- ..S ABMLND=ABMLND+1
- .K ABMU
- E S:($E($P(ABMS(ABMS),U,8),1,2)="N4") $P(ABMR(ABMS,ABMLN),U,5)=$P(ABMS(ABMS),U,8)
- ; Diagnosis code Form locator 24E
- S ABMCORDX=$P(ABMS(ABMS),U,5)
- S ABMCORDX=$P(ABMCORDX,",",1,4)
- I +$G(ABMCORDX)=0 S ABMCORDX=1 ;for flat rate; doesn't set corr. dx
- F ABMTMP=1:1:$L(ABMCORDX,",") D
- .S $P(ABMCORDX,",",ABMTMP)=$P("A^B^C^D^E^F^G^H^I^J^K^L^","^",$P(ABMCORDX,",",ABMTMP))
- S $P(ABMR(ABMS,ABMLN),U,6)=$TR(ABMCORDX,",")
- ; Charges Form locator 24F
- S $P(ABMR(ABMS,ABMLN),U,7)=$P(ABMS(ABMS),U)
- ; Days or units Form locator 24G
- S $P(ABMR(ABMS,ABMLN),U,8)=$P(ABMS(ABMS),U,6)
- ; Reserved for local use Form locator 24K (1)
- I $P(ABMS(ABMS),"^",9)'="" D
- .S ABMLOCAL=$P(ABMS(ABMS),"^",9)
- .I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",15)="MD" D
- ..S $P(ABMR(ABMS,ABMLN-1),U,3)=ABMLOCAL
- .K ABMLOCAL
- I $G(ABMP("EXP"))=35 D
- .S:+$G(ABMDUZ2)=0 ABMDUZ2=DUZ(2)
- .S ABMPQ=$S(ABMP("ITYPE")="R":"1C"_" ",ABMP("ITYPE")="D":"1D"_" ",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B"_" ")
- I ($P(ABMS(ABMS),U,11)&($G(ABMP("NPIS"))'="")&(ABMP("NPIS")'="N")) D
- .S $P(ABMR(ABMS,ABMLN-1),U,2)=ABMPQ
- .S $P(ABMR(ABMS,ABMLN-1),U,3)=$P(ABMS(ABMS),U,9)
- I $G(ABMP("ITYPE"))="R"&($G(ABMP("BTYP"))="831") S $P(ABMR(ABMS,ABMLN-1),U,3)=""
- S:$P(ABMS(ABMS),U,11) $P(ABMR(ABMS,ABMLN),U,11)=$P(ABMS(ABMS),U,11) ;Form Locator 24K (2)
- K ABMS(ABMS),ABMPTR,ABMCORDX
- Q
- ABMDF35E ; IHS/SD/SDR - Set HCFA1500 (02/12) Print Array - Part 5 ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**13,21,22**;NOV 12, 2009;Build 418
- +2 ;IHS/SD/SDR - 2.6*21 - HEAT223194 - Fixed EPSDT field so it will print either the second character from the referral
- +3 ; or an 'U' for no referral.
- +4 ;IHS/SD/SDR 2.6*22 HEAT335246 Added code to print the appropriate CPT based on if the NDC prompt is answered or not.
- +5 ;
- +6 ; *********************************************************************
- +7 ;
- EMG ;EP for setting Emerg or Special Prog variable
- +1 ;S (ABM,ABM("EPSDT"))=0 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- +2 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- SET ABM=0
- +3 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- SET ABM("EPSDT")=""
- +4 FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM))
- IF 'ABM
- QUIT
- Begin DoDot:1
- +5 SET ABM("X")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,0),U)
- +6 IF ABM("X")=""
- QUIT
- +7 ;I $P(^ABMDCODE(ABM("X"),0),U)["EPSDT"!($P(^(0),U))["FAMILY" S ABM("EPSDT")=1 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- +8 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- IF ($PIECE(^ABMDCODE(ABM("X"),0),U,3)["EPSDT")
- Begin DoDot:2
- +9 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,0)),U,2)="N"
- SET ABM("EPSDT")="U"
- QUIT
- +10 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- SET ABM("EPSDT")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,1,0))
- +11 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- SET ABM("EPSDT")=$EXTRACT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,1,ABM("EPSDT"),0)),U),2)
- End DoDot:2
- +12 ;abm*2.6*21 IHS/SD/SDR HEAT223194
- IF ($PIECE(^(0),U,3)["FAMILY")
- SET ABM("EPSDT")="X"
- End DoDot:1
- +13 SET ABM("EMG")=$SELECT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,5)="Y":1,1:0)
- +14 QUIT
- +15 ;
- PROC ;EP for setting the procedure portion of the ABMF array
- +1 ; input vars: ABMS(ABMS) - the procedure line in internal format
- +2 ; ABMS("I") - the current line number
- +3 ;
- +4 ; output vars: ABMF(ABMS("I")) - procedure line in external format
- +5 ; ABMF(ABMS("I")-1) - top line for extended descriptions
- +6 ;
- +7 KILL %DT
- +8 ;Service date from
- SET ABMFDT=$PIECE(ABMS(ABMS),U,2)
- +9 ;Service date from
- SET X=$PIECE($PIECE(ABMS(ABMS),U,2),"@")
- +10 DO ^%DT
- +11 ; Service date from in FM Format
- SET $PIECE(ABMS(ABMS),U,2)=Y
- +12 ;Service date to
- SET ABMTDT=$PIECE(ABMS(ABMS),U,3)
- +13 ;Service date to
- SET X=$PIECE($PIECE(ABMS(ABMS),U,3),"@")
- +14 DO ^%DT
- +15 ; Service date to in FM format
- SET $PIECE(ABMS(ABMS),U,3)=Y
- +16 SET ABMR(ABMS,ABMLN)=""
- +17 ; Form locator 24A
- SET ABMR(ABMS,ABMLN)=$PIECE(ABMS(ABMS),U,2,3)
- +18 ;check if time on charge (anes); if so, add as line 1
- +19 IF ABMFDT["@"
- Begin DoDot:1
- +20 SET $PIECE(ABMR(ABMS,ABMLN-1),U)="7Begin "_$TRANSLATE($PIECE(ABMFDT,"@",2),":")
- +21 SET $PIECE(ABMR(ABMS,ABMLN-1),U)=$PIECE(ABMR(ABMS,ABMLN-1),U)_" End "_$TRANSLATE($PIECE(ABMTDT,"@",2),":")
- End DoDot:1
- +22 ;
- +23 ; Set Place of service ; Form locator 24B
- +24 ; 21 if visit type is inpatient
- +25 ; 24 if visit type is ambulatory surgery
- +26 ; 23 if clinic is emergency medicine (code 30)
- +27 ; 11 for all other cases
- +28 IF $PIECE(ABMS(ABMS),U,10)
- SET $PIECE(ABMR(ABMS,ABMLN),U,3)=$PIECE($GET(^ABMDCODE($PIECE(ABMS(ABMS),U,10),0)),U)
- +29 IF '$TEST
- Begin DoDot:1
- +30 SET $PIECE(ABMR(ABMS,ABMLN),U,3)=$SELECT(ABMP("VTYP")=111!($GET(ABMP("BTYP"))=111):21,ABMP("BTYP")=831:24,1:11)
- +31 ; if Place of service set to 11 check to see if pointer exists
- +32 ; in Parameter file to Code file and use it
- +33 IF $PIECE(ABMR(ABMS,ABMLN),U,3)=11
- Begin DoDot:2
- +34 SET ABMPTR=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),"^",6)
- +35 IF ABMPTR=""
- SET ABMPTR=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",6)
- IF 'ABMPTR
- QUIT
- +36 IF '$DATA(^ABMDCODE(ABMPTR,0))
- QUIT
- +37 SET $PIECE(ABMR(ABMS,ABMLN),U,3)=$PIECE(^ABMDCODE(ABMPTR,0),U)
- End DoDot:2
- +38 IF $PIECE($GET(^DIC(40.7,+ABMP("CLN"),0)),"^",2)=30
- Begin DoDot:2
- +39 SET $PIECE(ABMR(ABMS,ABMLN),U,3)=23
- End DoDot:2
- End DoDot:1
- +40 ;
- +41 ; Set CPT/HCPCS ; Form locator 24D
- +42 ;abm*2.6*22 IHS/SD/SDR HEAT335246
- IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y"
- SET $PIECE(ABMR(ABMS,ABMLN),U,5)=$PIECE(ABMS(ABMS),U,4)
- +43 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)]""
- Begin DoDot:1
- +44 ;don't write default CPT if they want NDC to print ;abm*2.6*22 IHS/SD/SDR HEAT335246
- IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y"
- QUIT
- +45 ;CSV-c
- SET $PIECE(ABMR(ABMS,ABMLN),U,5)=$PIECE($$CPT^ABMCVAPI($PIECE(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,16),ABMP("VDT")),U,2)
- End DoDot:1
- +46 IF '$TEST
- IF $PIECE($GET(ABMS(ABMS)),U,4)]""
- Begin DoDot:1
- +47 SET $PIECE(ABMR(ABMS,ABMLN),U,5)=" "_$PIECE(ABMS(ABMS),U,4)
- +48 ; If CPT code, and modifier exists, add it
- +49 SET $PIECE(ABMR(ABMS,ABMLN),U,5)=" "_$PIECE(ABMR(ABMS,ABMLN),U,5)_$SELECT($EXTRACT($PIECE(ABMS(ABMS),U,8))="#":" "_$PIECE($PIECE(ABMS(ABMS),U,8)," "),1:"")
- +50 ;S:$G(ABM("EPSDT")) $P(ABMR(ABMS,ABMLN),U,9)="X" ; Form locator 24H ;abm*2.6*21 IHS/SD/SDR HEAT223194
- +51 ; Form locator 24H ;abm*2.6*21 IHS/SD/SDR HEAT223194
- IF $GET(ABM("EPSDT"))'=""
- SET $PIECE(ABMR(ABMS,ABMLN),U,9)=$GET(ABM("EPSDT"))
- +52 ; Form locator 24C
- IF $GET(ABM("EMG"))
- SET $PIECE(ABMR(ABMS,ABMLN),U,4)="X"
- End DoDot:1
- IF 1
- +53 IF '$TEST
- Begin DoDot:1
- +54 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["PHC MEDICAID"
- SET $PIECE(ABMS(ABMS),U,8)=$TRANSLATE($PIECE(ABMS(ABMS),U,8),"-")
- End DoDot:1
- +55 IF $PIECE(ABMR(ABMS,ABMLN),U,5)["NO CODE SELECTED"
- SET $PIECE(ABMR(ABMS,ABMLN),U,5)=""
- +56 IF $LENGTH($PIECE(ABMS(ABMS),U,8))>16
- IF ($EXTRACT($PIECE(ABMS(ABMS),U,8),1,2)="N4")
- Begin DoDot:1
- +57 SET ABMU("LNG")=60
- +58 SET ABMU("TXT")=$PIECE(ABMS(ABMS),U,8)
- +59 SET ABMU=3
- +60 DO LNG^ABMDWRAP
- +61 SET ABMLND=ABMLN-1
- SET J=0
- +62 FOR
- SET J=$ORDER(ABMU(J))
- IF +J=0!(+J>2)
- QUIT
- Begin DoDot:2
- +63 SET $PIECE(ABMR(ABMS,ABMLND),U)=$GET(ABMU(J))
- +64 SET ABMLND=ABMLND+1
- End DoDot:2
- +65 KILL ABMU
- End DoDot:1
- +66 IF '$TEST
- IF ($EXTRACT($PIECE(ABMS(ABMS),U,8),1,2)="N4")
- SET $PIECE(ABMR(ABMS,ABMLN),U,5)=$PIECE(ABMS(ABMS),U,8)
- +67 ; Diagnosis code Form locator 24E
- +68 SET ABMCORDX=$PIECE(ABMS(ABMS),U,5)
- +69 SET ABMCORDX=$PIECE(ABMCORDX,",",1,4)
- +70 ;for flat rate; doesn't set corr. dx
- IF +$GET(ABMCORDX)=0
- SET ABMCORDX=1
- +71 FOR ABMTMP=1:1:$LENGTH(ABMCORDX,",")
- Begin DoDot:1
- +72 SET $PIECE(ABMCORDX,",",ABMTMP)=$PIECE("A^B^C^D^E^F^G^H^I^J^K^L^","^",$PIECE(ABMCORDX,",",ABMTMP))
- End DoDot:1
- +73 SET $PIECE(ABMR(ABMS,ABMLN),U,6)=$TRANSLATE(ABMCORDX,",")
- +74 ; Charges Form locator 24F
- +75 SET $PIECE(ABMR(ABMS,ABMLN),U,7)=$PIECE(ABMS(ABMS),U)
- +76 ; Days or units Form locator 24G
- +77 SET $PIECE(ABMR(ABMS,ABMLN),U,8)=$PIECE(ABMS(ABMS),U,6)
- +78 ; Reserved for local use Form locator 24K (1)
- +79 IF $PIECE(ABMS(ABMS),"^",9)'=""
- Begin DoDot:1
- +80 SET ABMLOCAL=$PIECE(ABMS(ABMS),"^",9)
- +81 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",15)="MD"
- Begin DoDot:2
- +82 SET $PIECE(ABMR(ABMS,ABMLN-1),U,3)=ABMLOCAL
- End DoDot:2
- +83 KILL ABMLOCAL
- End DoDot:1
- +84 IF $GET(ABMP("EXP"))=35
- Begin DoDot:1
- +85 IF +$GET(ABMDUZ2)=0
- SET ABMDUZ2=DUZ(2)
- +86 SET ABMPQ=$SELECT(ABMP("ITYPE")="R":"1C"_" ",ABMP("ITYPE")="D":"1D"_" ",$PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$PIECE($GET(^ABMREFID($PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B
- "_" ")
- End DoDot:1
- +87 IF ($PIECE(ABMS(ABMS),U,11)&($GET(ABMP("NPIS"))'="")&(ABMP("NPIS")'="N"))
- Begin DoDot:1
- +88 SET $PIECE(ABMR(ABMS,ABMLN-1),U,2)=ABMPQ
- +89 SET $PIECE(ABMR(ABMS,ABMLN-1),U,3)=$PIECE(ABMS(ABMS),U,9)
- End DoDot:1
- +90 IF $GET(ABMP("ITYPE"))="R"&($GET(ABMP("BTYP"))="831")
- SET $PIECE(ABMR(ABMS,ABMLN-1),U,3)=""
- +91 ;Form Locator 24K (2)
- IF $PIECE(ABMS(ABMS),U,11)
- SET $PIECE(ABMR(ABMS,ABMLN),U,11)=$PIECE(ABMS(ABMS),U,11)
- +92 KILL ABMS(ABMS),ABMPTR,ABMCORDX
- +93 QUIT