- FBXIP32 ;WOIFO/SAB-PATCH INSTALL ROUTINE ;7/19/2001
- ;;3.5;FEE BASIS;**32**;JAN 30, 1995
- Q
- ;
- PS ; post-install entry point
- ; create KIDS checkpoints with call backs
- N FBX,Y
- F FBX="UPDPOV","STATLTR","REQINFO" D
- . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP32")
- . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
- Q
- ;
- UPDPOV ; Update Selected Purpose of Visits (POV)
- N FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y
- D BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
- ;
- ; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
- ;I $P($G(^FBAA(161.8,2,0)),U)'="OUTPATIENT" D Q
- ;. D MES^XPDUTL(" ERROR: Fee Program with IEN 2 is not OUTPATIENT.")
- ;. D MES^XPDUTL(" Purpose of Visits could not be updated.")
- ;
- ; update POVs
- K FBFDA
- ; loop thru POVs
- F FBI=1:1 S FBX=$P($T(POV+FBI),";;",2) Q:FBX="END" D
- . S FBCODE=$P(FBX,U)
- . S FBNAME=$P(FBX,U,2)
- . S FBPROG=$P(FBX,U,3)
- . ;
- . ; locate POV in file
- . S FBDA=$$FIND1^DIC(161.82,"","X",FBCODE,"AC")
- . ;
- . ; if POV found then check and if necessary add to update array
- . I FBDA D
- . . I $$GET1^DIQ(161.82,FBDA_",",.01)'=FBNAME S FBFDA(161.82,FBDA_",",.01)=FBNAME
- . . I $$GET1^DIQ(161.82,FBDA_",",2,"I")'=FBPROG D
- . . . I FBPROG]"" S FBFDA(161.82,FBDA_",",2)=FBPROG
- . . . I FBPROG="" S FBFDA(161.82,FBDA_",",2)="@"
- . ;
- . ; if POV not found then add it
- . I 'FBDA D
- . . N DA,DD,DIC,DINUM,DLAYGO,DO,X
- . . S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
- . . S X=FBNAME Q:X=""
- . . S DIC("DR")="3////^S X=FBCODE"
- . . I FBPROG]"" S DIC("DR")=DIC("DR")_";2////^S X=FBPROG"
- . . I +FBCODE,'$D(^FBAA(161.82,+FBCODE,0)) S DINUM=+FBCODE
- . . D FILE^DICN
- . . I Y<0 D MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)
- ;
- ; actually update the found POVs
- I $D(FBFDA) D FILE^DIE("","FBFDA")
- ;
- D MES^XPDUTL(" Done.")
- Q
- ;
- POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)
- ;;52^OUTPATIENT 38 U.S.C. 1725^
- ;;39^INPATIENT 38 U.S.C. 1725^6
- ;;END
- ;
- STATLTR ; Populate field .06 in file 162.92 for appropriate status
- N FBDA,FBFDA,FBORDER
- ; loop thru status orders that need to be populated
- F FBORDER=10,40,70,90 D
- . S FBDA=$$STATUS^FBUCUTL(FBORDER) ; get ien
- . Q:'FBDA
- . Q:$P($G(^FB(162.92,FBDA,0)),U,6)]"" ; field already populated
- . I FBORDER=10 S FBFDA(162.92,FBDA_",",.06)="1725 REQUEST INFO"
- . I FBORDER>10 S FBFDA(162.92,FBDA_",",.06)="1725 DISPOSITION"
- ; update entries
- I $D(FBFDA) D FILE^DIE("E","FBFDA") D MSG^DIALOG()
- Q
- ;
- REQINFO ; Add/Update data in file 162.93
- D SSFC^FBXIP32A ; signed statement from claimant
- Q
- ;FBXIP32
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP32 2660 printed Jan 18, 2025@03:02:52 Page 2
- FBXIP32 ;WOIFO/SAB-PATCH INSTALL ROUTINE ;7/19/2001
- +1 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
- +2 QUIT
- +3 ;
- PS ; post-install entry point
- +1 ; create KIDS checkpoints with call backs
- +2 NEW FBX,Y
- +3 FOR FBX="UPDPOV","STATLTR","REQINFO"
- Begin DoDot:1
- +4 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP32")
- +5 IF 'Y
- DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
- End DoDot:1
- +6 QUIT
- +7 ;
- UPDPOV ; Update Selected Purpose of Visits (POV)
- +1 NEW FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y
- +2 DO BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
- +3 ;
- +4 ; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
- +5 ;I $P($G(^FBAA(161.8,2,0)),U)'="OUTPATIENT" D Q
- +6 ;. D MES^XPDUTL(" ERROR: Fee Program with IEN 2 is not OUTPATIENT.")
- +7 ;. D MES^XPDUTL(" Purpose of Visits could not be updated.")
- +8 ;
- +9 ; update POVs
- +10 KILL FBFDA
- +11 ; loop thru POVs
- +12 FOR FBI=1:1
- SET FBX=$PIECE($TEXT(POV+FBI),";;",2)
- if FBX="END"
- QUIT
- Begin DoDot:1
- +13 SET FBCODE=$PIECE(FBX,U)
- +14 SET FBNAME=$PIECE(FBX,U,2)
- +15 SET FBPROG=$PIECE(FBX,U,3)
- +16 ;
- +17 ; locate POV in file
- +18 SET FBDA=$$FIND1^DIC(161.82,"","X",FBCODE,"AC")
- +19 ;
- +20 ; if POV found then check and if necessary add to update array
- +21 IF FBDA
- Begin DoDot:2
- +22 IF $$GET1^DIQ(161.82,FBDA_",",.01)'=FBNAME
- SET FBFDA(161.82,FBDA_",",.01)=FBNAME
- +23 IF $$GET1^DIQ(161.82,FBDA_",",2,"I")'=FBPROG
- Begin DoDot:3
- +24 IF FBPROG]""
- SET FBFDA(161.82,FBDA_",",2)=FBPROG
- +25 IF FBPROG=""
- SET FBFDA(161.82,FBDA_",",2)="@"
- End DoDot:3
- End DoDot:2
- +26 ;
- +27 ; if POV not found then add it
- +28 IF 'FBDA
- Begin DoDot:2
- +29 NEW DA,DD,DIC,DINUM,DLAYGO,DO,X
- +30 SET DIC="^FBAA(161.82,"
- SET DIC(0)="L"
- SET DLAYGO=161.82
- +31 SET X=FBNAME
- if X=""
- QUIT
- +32 SET DIC("DR")="3////^S X=FBCODE"
- +33 IF FBPROG]""
- SET DIC("DR")=DIC("DR")_";2////^S X=FBPROG"
- +34 IF +FBCODE
- IF '$DATA(^FBAA(161.82,+FBCODE,0))
- SET DINUM=+FBCODE
- +35 DO FILE^DICN
- +36 IF Y<0
- DO MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)
- End DoDot:2
- End DoDot:1
- +37 ;
- +38 ; actually update the found POVs
- +39 IF $DATA(FBFDA)
- DO FILE^DIE("","FBFDA")
- +40 ;
- +41 DO MES^XPDUTL(" Done.")
- +42 QUIT
- +43 ;
- POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)
- +1 ;;52^OUTPATIENT 38 U.S.C. 1725^
- +2 ;;39^INPATIENT 38 U.S.C. 1725^6
- +3 ;;END
- +4 ;
- STATLTR ; Populate field .06 in file 162.92 for appropriate status
- +1 NEW FBDA,FBFDA,FBORDER
- +2 ; loop thru status orders that need to be populated
- +3 FOR FBORDER=10,40,70,90
- Begin DoDot:1
- +4 ; get ien
- SET FBDA=$$STATUS^FBUCUTL(FBORDER)
- +5 if 'FBDA
- QUIT
- +6 ; field already populated
- if $PIECE($GET(^FB(162.92,FBDA,0)),U,6)]""
- QUIT
- +7 IF FBORDER=10
- SET FBFDA(162.92,FBDA_",",.06)="1725 REQUEST INFO"
- +8 IF FBORDER>10
- SET FBFDA(162.92,FBDA_",",.06)="1725 DISPOSITION"
- End DoDot:1
- +9 ; update entries
- +10 IF $DATA(FBFDA)
- DO FILE^DIE("E","FBFDA")
- DO MSG^DIALOG()
- +11 QUIT
- +12 ;
- REQINFO ; Add/Update data in file 162.93
- +1 ; signed statement from claimant
- DO SSFC^FBXIP32A
- +2 QUIT
- +3 ;FBXIP32